pkg/atm_ocn_coupler/set_runoffmap.F

7f58e89433 Jean*0001 #include "CPP_OPTIONS.h"
                0002
8276725b84 Jean*0003 CBOP 0
                0004 C !ROUTINE: SET_RUNOFFMAP
                0005
                0006 C !INTERFACE:
                0007       SUBROUTINE SET_RUNOFFMAP( msgUnit )
                0008
                0009 C !DESCRIPTION:
7f58e89433 Jean*0010 C     *==========================================================*
                0011 C     | SUBROUTINE SET_RUNOFFMAP
                0012 C     | o define runoff mapping from atmos. grid (land) to
                0013 C     |   ocean grid
                0014 C     *==========================================================*
                0015
8276725b84 Jean*0016 C !USES:
                0017       IMPLICIT NONE
                0018 C     == Global variables ==
7f58e89433 Jean*0019 #include "ATMSIZE.h"
                0020 #include "OCNSIZE.h"
8276725b84 Jean*0021 #include "CPL_PARAMS.h"
7f58e89433 Jean*0022 #include "CPL_MAP2GRIDS.h"
                0023
8276725b84 Jean*0024 C !INPUT/OUTPUT PARAMETERS:
                0025 C     msgUnit    :: log-file I/O unit
                0026       INTEGER msgUnit
7f58e89433 Jean*0027
8276725b84 Jean*0028 C !LOCAL VARIABLES:
7f58e89433 Jean*0029       INTEGER n, ijo, ija
                0030       INTEGER lengthName, lengthRec, iRec
                0031       Real*8  r8seg(3)
                0032       Real*8  tmpfld(3,ROsize), rAc(Nx_ocn*Ny_ocn)
8276725b84 Jean*0033 CEOP
                0034
                0035       WRITE(msgUnit,'(2A)') 'SET_RUNOFFMAP: ','entering'
7f58e89433 Jean*0036
                0037 C-    Initialize to zero :
                0038         DO n=1,ROsize
                0039           ijROocn(n)=0
                0040           ijROatm(n)=0
                0041           arROmap(n)=0.
                0042         ENDDO
                0043
8276725b84 Jean*0044         nROmap = runOffMapSize
                0045 c       lengthName=ILNBLNK( runOffMapFile ) ! eesup/src/utils.F not compiled here
7f58e89433 Jean*0046         lengthName=0
8276725b84 Jean*0047         DO n=1,LEN( runOffMapFile )
                0048          IF ( runOffMapFile(n:n).NE.' ' ) lengthName=n
7f58e89433 Jean*0049         ENDDO
8276725b84 Jean*0050         WRITE(msgUnit,'(3A,I6)')
                0051      &     ' runOffMapFile =>>', runOffMapFile(1:lengthName),
                0052      &   '<<= , runOffMapSize=', runOffMapSize
7f58e89433 Jean*0053         IF ( lengthName.EQ.0 ) nROmap=0
8276725b84 Jean*0054         IF ( nROmap.EQ.0 ) THEN
                0055           WRITE(msgUnit,'(2A,I9,A)') 'SET_RUNOFFMAP: ',
                0056      &                'nothing to set (nROmap=', nROmap, ' )'
                0057           RETURN
                0058         ENDIF
                0059         IF ( nROmap.GT.ROsize ) THEN
                0060           WRITE(msgUnit,'(2A)') '*** ERROR *** SET_RUNOFFMAP: ',
                0061      &                          'runOffMapSize exceeds ROsize'
                0062           STOP 'ABNORMAL END: S/R SET_RUNOFFMAP'
                0063         ENDIF
7f58e89433 Jean*0064
                0065 C-    Read area catchment from file ;
8276725b84 Jean*0066       WRITE(msgUnit,'(2A)') 'SET_RUNOFFMAP: ','reading runOffMapFile'
7f58e89433 Jean*0067 c       lengthRec=3*nROmap*WORDLENGTH*2
8276725b84 Jean*0068 c       OPEN(88, FILE=runOffMapFile(1:lengthName), STATUS='OLD',
7f58e89433 Jean*0069 c    &       ACCESS='direct', RECL=lengthRec )
8276725b84 Jean*0070 c       READ(88,rec=1) tmpfld
7f58e89433 Jean*0071         lengthRec=3*WORDLENGTH*2
8276725b84 Jean*0072         OPEN(88, FILE=runOffMapFile(1:lengthName), STATUS='OLD',
7f58e89433 Jean*0073      &       ACCESS='direct', RECL=lengthRec )
                0074         DO n=1,nROmap
                0075          iRec = n
                0076          READ(88,rec=iRec) r8seg
8276725b84 Jean*0077          tmpfld(1,n) = r8seg(1)
                0078          tmpfld(2,n) = r8seg(2)
                0079          tmpfld(3,n) = r8seg(3)
7f58e89433 Jean*0080         ENDDO
                0081         CLOSE(88)
                0082 #ifdef _BYTESWAPIO
                0083          CALL MDS_BYTESWAPR8( 3*nROmap, tmpfld )
                0084 #endif
                0085 c       n=nROmap
8276725b84 Jean*0086 c       WRITE(msgUnit,'(A,3I5,F11.6)') 'ROmap:',n,nint(tmpfld(1,n)),
7f58e89433 Jean*0087 c    &                            NINT(tmpfld(2,n)),tmpfld(3,n)*1.d-9
                0088
8276725b84 Jean*0089 C-    Read (ocean) grid cell area from file ;
                0090       WRITE(msgUnit,'(2A)') 'SET_RUNOFFMAP: ','reading OCN grid area'
                0091         lengthRec=Nx_ocn*Ny_ocn*WORDLENGTH*2
                0092         OPEN(88, FILE='RA.bin', STATUS='OLD',
                0093      &       ACCESS='direct', RECL=lengthRec )
                0094         iRec = 1
                0095         READ(88,rec=iRec) rAc
                0096         CLOSE(88)
                0097 #ifdef _BYTESWAPIO
                0098         CALL MDS_BYTESWAPR8( Nx_ocn*Ny_ocn, rAc )
                0099 #endif
                0100 c       WRITE(msgUnit,*) 'rAc=', rAc(1), rAc(17), rAc(17+16*Nx_ocn)
                0101
7f58e89433 Jean*0102 C----------------------------------------------------------
                0103
                0104 C-    Define mapping :
                0105         DO n=1,nROmap
8276725b84 Jean*0106           ija = NINT(tmpfld(1,n))
                0107           ijo = NINT(tmpfld(2,n))
7f58e89433 Jean*0108           IF ( ija.LT.1 .OR. ija.GT.Nx_atm*Ny_atm ) THEN
8276725b84 Jean*0109             WRITE(msgUnit,'(2A)') '*** ERROR *** SET_RUNOFFMAP: ',
                0110      &                            'ijROatm out of range !'
                0111             STOP 'ABNORMAL END: S/R SET_RUNOFFMAP'
7f58e89433 Jean*0112           ENDIF
8276725b84 Jean*0113           ijROatm(n) = ija
7f58e89433 Jean*0114           IF ( ijo.LT.1 .OR. ijo.GT.Nx_ocn*Ny_ocn ) THEN
8276725b84 Jean*0115             WRITE(msgUnit,'(2A)') '*** ERROR *** SET_RUNOFFMAP: ',
                0116      &                            'ijROocn out of range !'
7f58e89433 Jean*0117             STOP 'ABNORMAL END: S/R SET_RUNOFFMAP'
                0118           ELSEIF ( rAc(ijo).GT.0. ) THEN
8276725b84 Jean*0119             arROmap(n) = tmpfld(3,n)/rAc(ijo);
                0120           ELSE
                0121             arROmap(n) = 0.
7f58e89433 Jean*0122           ENDIF
8276725b84 Jean*0123           ijROocn(n) = ijo
7f58e89433 Jean*0124         ENDDO
                0125
                0126 C-      print to check :
8276725b84 Jean*0127         n = 1
                0128         WRITE(msgUnit,'(A,3I5,F9.6)') ' check ROmap:',
7f58e89433 Jean*0129      &                          n,ijROatm(n),ijROocn(n),arROmap(n)
8276725b84 Jean*0130         n = nROmap
                0131         WRITE(msgUnit,'(A,3I5,F9.6)') ' check ROmap:',
7f58e89433 Jean*0132      &                          n,ijROatm(n),ijROocn(n),arROmap(n)
                0133
8276725b84 Jean*0134       WRITE(msgUnit,'(2A,I9,A)') 'SET_RUNOFFMAP: ',
                0135      &                     'done (nROmap=', nROmap, ' )'
                0136
7f58e89433 Jean*0137       RETURN
                0138       END