set_runoffmap.F

C $Header: /u/gcmpack/MITgcm/pkg/atm_ocn_coupler/set_runoffmap.F,v 1.4 2013/12/02 22:03:08 jmc Exp $
C $Name:  $

#include "CPP_OPTIONS.h"

CBOP 0
C !ROUTINE: SET_RUNOFFMAP

C !INTERFACE:
      SUBROUTINE SET_RUNOFFMAP( msgUnit )

C !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE SET_RUNOFFMAP
C     | o define runoff mapping from atmos. grid (land) to
C     |   ocean grid
C     *==========================================================*

C !USES:
      IMPLICIT NONE
C     == Global variables ==
#include "ATMSIZE.h"
#include "OCNSIZE.h"
#include "CPL_PARAMS.h"
#include "CPL_MAP2GRIDS.h"

C !INPUT/OUTPUT PARAMETERS:
C     msgUnit    :: log-file I/O unit
      INTEGER msgUnit

C !LOCAL VARIABLES:
      INTEGER n, ijo, ija
      INTEGER lengthName, lengthRec, iRec
      Real*8  r8seg(3)
      Real*8  tmpfld(3,ROsize), rAc(Nx_ocn*Ny_ocn)
CEOP

      WRITE(msgUnit,'(2A)') 'SET_RUNOFFMAP: ','entering'

C-    Initialize to zero :
        DO n=1,ROsize
          ijROocn(n)=0
          ijROatm(n)=0
          arROmap(n)=0.
        ENDDO

        nROmap = runOffMapSize
c       lengthName=ILNBLNK( runOffMapFile ) ! eesup/src/utils.F not compiled here
        lengthName=0
        DO n=1,LEN( runOffMapFile )
         IF ( runOffMapFile(n:n).NE.' ' ) lengthName=n
        ENDDO
        WRITE(msgUnit,'(3A,I6)')
     &     ' runOffMapFile =>>', runOffMapFile(1:lengthName),
     &   '<<= , runOffMapSize=', runOffMapSize
        IF ( lengthName.EQ.0 ) nROmap=0
        IF ( nROmap.EQ.0 ) THEN
          WRITE(msgUnit,'(2A,I9,A)') 'SET_RUNOFFMAP: ',
     &                'nothing to set (nROmap=', nROmap, ' )'
          RETURN
        ENDIF
        IF ( nROmap.GT.ROsize ) THEN
          WRITE(msgUnit,'(2A)') '*** ERROR *** SET_RUNOFFMAP: ',
     &                          'runOffMapSize exceeds ROsize'
          STOP 'ABNORMAL END: S/R SET_RUNOFFMAP'
        ENDIF

C-    Read area catchment from file ;
      WRITE(msgUnit,'(2A)') 'SET_RUNOFFMAP: ','reading runOffMapFile'
c       lengthRec=3*nROmap*WORDLENGTH*2
c       OPEN(88, FILE=runOffMapFile(1:lengthName), STATUS='OLD',
c    &       ACCESS='direct', RECL=lengthRec )
c       READ(88,rec=1) tmpfld
        lengthRec=3*WORDLENGTH*2
        OPEN(88, FILE=runOffMapFile(1:lengthName), STATUS='OLD',
     &       ACCESS='direct', RECL=lengthRec )
        DO n=1,nROmap
         iRec = n
         READ(88,rec=iRec) r8seg
         tmpfld(1,n) = r8seg(1)
         tmpfld(2,n) = r8seg(2)
         tmpfld(3,n) = r8seg(3)
        ENDDO
        CLOSE(88)
#ifdef _BYTESWAPIO
         CALL MDS_BYTESWAPR8( 3*nROmap, tmpfld )
#endif
c       n=nROmap
c       WRITE(msgUnit,'(A,3I5,F11.6)') 'ROmap:',n,nint(tmpfld(1,n)),
c    &                            NINT(tmpfld(2,n)),tmpfld(3,n)*1.d-9

C-    Read (ocean) grid cell area from file ;
      WRITE(msgUnit,'(2A)') 'SET_RUNOFFMAP: ','reading OCN grid area'
        lengthRec=Nx_ocn*Ny_ocn*WORDLENGTH*2
        OPEN(88, FILE='RA.bin', STATUS='OLD',
     &       ACCESS='direct', RECL=lengthRec )
        iRec = 1
        READ(88,rec=iRec) rAc
        CLOSE(88)
#ifdef _BYTESWAPIO
        CALL MDS_BYTESWAPR8( Nx_ocn*Ny_ocn, rAc )
#endif
c       WRITE(msgUnit,*) 'rAc=', rAc(1), rAc(17), rAc(17+16*Nx_ocn)

C----------------------------------------------------------

C-    Define mapping :
        DO n=1,nROmap
          ija = NINT(tmpfld(1,n))
          ijo = NINT(tmpfld(2,n))
          IF ( ija.LT.1 .OR. ija.GT.Nx_atm*Ny_atm ) THEN
            WRITE(msgUnit,'(2A)') '*** ERROR *** SET_RUNOFFMAP: ',
     &                            'ijROatm out of range !'
            STOP 'ABNORMAL END: S/R SET_RUNOFFMAP'
          ENDIF
          ijROatm(n) = ija
          IF ( ijo.LT.1 .OR. ijo.GT.Nx_ocn*Ny_ocn ) THEN
            WRITE(msgUnit,'(2A)') '*** ERROR *** SET_RUNOFFMAP: ',
     &                            'ijROocn out of range !'
            STOP 'ABNORMAL END: S/R SET_RUNOFFMAP'
          ELSEIF ( rAc(ijo).GT.0. ) THEN
            arROmap(n) = tmpfld(3,n)/rAc(ijo);
          ELSE
            arROmap(n) = 0.
          ENDIF
          ijROocn(n) = ijo
        ENDDO

C-      print to check :
        n = 1
        WRITE(msgUnit,'(A,3I5,F9.6)') ' check ROmap:',
     &                          n,ijROatm(n),ijROocn(n),arROmap(n)
        n = nROmap
        WRITE(msgUnit,'(A,3I5,F9.6)') ' check ROmap:',
     &                          n,ijROatm(n),ijROocn(n),arROmap(n)

      WRITE(msgUnit,'(2A,I9,A)') 'SET_RUNOFFMAP: ',
     &                     'done (nROmap=', nROmap, ' )'

      RETURN
      END