C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_write_local.F,v 1.2 2009/06/09 22:46:06 jmc Exp $ C $Name: $ #include "AIM_OPTIONS.h" CBOP C !ROUTINE: AIM_WRITE_LOCAL C !INTERFACE: SUBROUTINE AIM_WRITE_LOCAL( I pref, suff, nNr, field, I bi, bj, iRec, myIter, myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE AIM_WRITE_LOCAL C | o Write local variable from AIM physics (=> no overlap) C | and reverse K index. C *==========================================================* C !USES IMPLICIT NONE C == Global variables === #include "AIM_SIZE.h" #include "EEPARAMS.h" c #include "PARAMS.h" C !INPUT/OUTPUT PARAMETERS: C == Routine arguments == C pref :: Prefix of the output file name C suff :: Suffix of the output file name C nNr :: 3rd dim. of the input field C field :: Field (from aim-physics) to write C bi,bj :: Tile index C iRec :: reccord number in the output file C myIter :: Current iteration number in simulation C myThid :: my Thread Id number CHARACTER*(*) pref,suff INTEGER nNr _RL field(sNx,sNy,nNr) INTEGER bi, bj, iRec, myIter, myThid #ifdef ALLOW_AIM C !FUNCTIONS: INTEGER ILNBLNK EXTERNAL C !LOCAL VARIABLES: CHARACTER*(MAX_LEN_MBUF) msgBuf _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) INTEGER iL INTEGER i, j, k, Katm CEOP C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| C-- Check for argument list consistency IF ( nNr.LT.1 .OR. nNr.GT.Nr ) THEN iL = ILNBLNK( pref ) WRITE(msgBuf,'(A,I10,A,2I5,A,I4,2A)') & 'AIM_WRITE_LOCAL (it=', myIter, ' bi,bj=', bi,bj, & ' iRec=', iRec, ' ): try to write: ', pref(1:iL) CALL PRINT_ERROR( msgBuf, myThid ) WRITE(msgBuf,'(A,I4,A,I4)') & 'AIM_WRITE_LOCAL: 3rd dim.(field)=',nNr,' has to be <',Nr CALL PRINT_ERROR( msgBuf , myThid) STOP 'ABNORMAL END: S/R AIM_WRITE_LOCAL' ENDIF C- Copy the input field into tempo. array: IF (nNr.EQ.Nr) THEN C- Reverse K index: DO k=1,Nr Katm = _KD2KA( k ) DO j=1,sNy DO i=1,sNx tmpFld(i,j,k) = field(i,j,Katm) ENDDO ENDDO ENDDO ELSE C- Do simple copy DO k=1,nNr DO j=1,sNy DO i=1,sNx tmpFld(i,j,k) = field(i,j,k) ENDDO ENDDO ENDDO ENDIF C- Write to file: CALL WRITE_LOCAL_RL( pref, suff, nNr, tmpFld, & bi, bj, iRec, myIter, myThid ) #endif /* ALLOW_AIM */ RETURN END