pkg/aim_v23/aim_write_local.F

d676f916b2 Jean*0001 #include "AIM_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: AIM_WRITE_LOCAL
                0005 C     !INTERFACE:
                0006       SUBROUTINE AIM_WRITE_LOCAL(
545bd614f1 Jean*0007      I               pref, suff, nNr, field,
                0008      I               bi, bj, iRec, myIter, myThid )
d676f916b2 Jean*0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE AIM_WRITE_LOCAL
                0012 C     | o Write local variable from AIM physics (=> no overlap)
                0013 C     |   and reverse K index.
                0014 C     *==========================================================*
                0015 C     !USES
                0016       IMPLICIT NONE
                0017
                0018 C     == Global variables ===
                0019 #include "AIM_SIZE.h"
                0020
                0021 #include "EEPARAMS.h"
                0022 c #include "PARAMS.h"
                0023
                0024 C     !INPUT/OUTPUT PARAMETERS:
                0025 C     == Routine arguments ==
545bd614f1 Jean*0026 C     pref   :: Prefix of the output file name
                0027 C     suff   :: Suffix of the output file name
                0028 C     nNr    :: 3rd dim. of the input field
                0029 C     field  :: Field (from aim-physics) to write
                0030 C     bi,bj  :: Tile index
                0031 C     iRec   :: reccord number in the output file
                0032 C     myIter :: Current iteration number in simulation
                0033 C     myThid :: my Thread Id number
d676f916b2 Jean*0034       CHARACTER*(*) pref,suff
                0035       INTEGER nNr
                0036       _RL field(sNx,sNy,nNr)
                0037       INTEGER bi, bj, iRec, myIter, myThid
                0038
                0039 #ifdef ALLOW_AIM
                0040
545bd614f1 Jean*0041 C     !FUNCTIONS:
                0042       INTEGER  ILNBLNK
                0043       EXTERNAL ILNBLNK
                0044
d676f916b2 Jean*0045 C     !LOCAL VARIABLES:
                0046       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0047       _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
545bd614f1 Jean*0048       INTEGER iL
                0049       INTEGER i, j, k, Katm
d676f916b2 Jean*0050 CEOP
                0051
                0052 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0053
545bd614f1 Jean*0054 C--   Check for argument list consistency
                0055       IF ( nNr.LT.1 .OR. nNr.GT.Nr ) THEN
                0056           iL = ILNBLNK( pref )
                0057           WRITE(msgBuf,'(A,I10,A,2I5,A,I4,2A)')
                0058      &      'AIM_WRITE_LOCAL (it=', myIter, ' bi,bj=', bi,bj,
                0059      &      ' iRec=', iRec, ' ): try to write: ', pref(1:iL)
                0060           CALL PRINT_ERROR( msgBuf, myThid )
                0061           WRITE(msgBuf,'(A,I4,A,I4)')
                0062      &      'AIM_WRITE_LOCAL: 3rd dim.(field)=',nNr,' has to be <',Nr
                0063           CALL PRINT_ERROR( msgBuf , myThid)
                0064           STOP 'ABNORMAL END: S/R AIM_WRITE_LOCAL'
                0065       ENDIF
                0066
d676f916b2 Jean*0067 C-    Copy the input field into tempo. array:
                0068       IF (nNr.EQ.Nr) THEN
                0069 C-     Reverse K index:
                0070        DO k=1,Nr
                0071         Katm = _KD2KA( k )
                0072         DO j=1,sNy
                0073          DO i=1,sNx
                0074           tmpFld(i,j,k) = field(i,j,Katm)
                0075          ENDDO
                0076         ENDDO
                0077        ENDDO
545bd614f1 Jean*0078       ELSE
                0079 C-     Do simple copy
d676f916b2 Jean*0080        DO k=1,nNr
                0081         DO j=1,sNy
                0082          DO i=1,sNx
                0083           tmpFld(i,j,k) = field(i,j,k)
                0084          ENDDO
                0085         ENDDO
                0086        ENDDO
                0087       ENDIF
                0088
                0089 C-    Write to file:
545bd614f1 Jean*0090       CALL WRITE_LOCAL_RL( pref, suff, nNr, tmpFld,
                0091      &                     bi, bj, iRec, myIter, myThid )
d676f916b2 Jean*0092
                0093 #endif /* ALLOW_AIM */
                0094       RETURN
                0095       END