var/obsproc/MAP_plot/Dir_map/mdlobs1.F

   1       SUBROUTINE MDLOBS1(NS,NNB,NNE,FOBS,PSOBS,XI,YJ,FMDL,PSA,IX,JX,KX,
   2      -                                                    ICROSS,NAME)
   3 C
   4       DIMENSION FOBS(NS,KX),PSOBS(NS),XI(NS),YJ(NS),
   5      -          FMDL(IX,JX,KX),PSA(IX,JX),PSD(IX,JX),
   6      *          FF(JX-ICROSS,IX-ICROSS)
   7       CHARACTER NAME*4,FVAL*8,SID*2
   8 C
   9       IF (ICROSS.EQ.0) CALL P1P2(PSD,PSA,IX,JX)
  10 C
  11       DO K = 1,KX
  12 C        PRINT *,'* LEVEL K =',K,'  VARIABLE: ',NAME,'  NS=',NS
  13 C .. decoupled
  14         DO I=1,IX-ICROSS
  15         DO J=1,JX-ICROSS
  16           IF (ICROSS.EQ.0) THEN
  17             PSFC = PSD(I,J)
  18           ELSE
  19             PSFC = PSA(I,J)
  20           ENDIF
  21           FMDL(I,J,K) = FMDL(I,J,K)/PSFC
  22         END DO
  23         END DO
  24 C
  25         DO N = NNB,NNE
  26 C .. interpolation
  27         CALL BINT(FOBS(N,K),XI(N),YJ(N),FMDL(1,1,K),IX,JX,ICROSS)
  28 C
  29 C .. coupled
  30         FOBS(N,K)=FOBS(N,K)*PSOBS(N)
  31 C        PRINT 10, N,K,XI(N),YJ(N),NAME,FOBS(N,K)
  32  10     format('N=',I3,' K=',I2,' IX=',F8.2,' JX=',F8.2,2X,A4,'=',F10.3)
  33         END DO
  34 C .. coupled
  35         DO I=1,IX-ICROSS
  36         DO J=1,JX-ICROSS
  37           IF (ICROSS.EQ.0) THEN
  38             PSFC = PSD(I,J)
  39           ELSE
  40             PSFC = PSA(I,J)
  41           ENDIF
  42           FMDL(I,J,K) = FMDL(I,J,K)*PSFC
  43         END DO
  44         END DO
  45 C
  46       END DO
  47 C
  48       RETURN
  49       END
  50 C