C $Header: /u/gcmpack/MITgcm/verification/carbon/code_ad/ptracers_init.F,v 1.2 2005/05/19 00:50:30 jmc Exp $
C $Name: $
#include "PTRACERS_OPTIONS.h"
#ifdef ALLOW_GCHEM
# include "GCHEM_OPTIONS.h"
#endif
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: PTRACERS_INIT
C !INTERFACE:
SUBROUTINE PTRACERS_INIT( myThid )
C !DESCRIPTION:
C Initialize PTRACERS data structures
C !USES:
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "PTRACERS_SIZE.h"
#include "PTRACERS.h"
C !INPUT PARAMETERS:
C myThid :: thread number
INTEGER myThid
#ifdef ALLOW_PTRACERS
C !LOCAL VARIABLES:
C i,j,k,bi,bj,iTracer :: loop indices
INTEGER i,j,k,bi,bj,iTracer
CHARACTER*(10) suff
CEOP
C Loop over tracers
DO iTracer = 1, PTRACERS_num
C Loop over tiles
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
C Initialize arrays in common blocks :
DO k=1,Nr
DO j=1-Oly,sNy+OLy
DO i=1-Olx,sNx+Olx
IF ( K.EQ.1 .AND. hFacC(I,J,K,bi,bj).NE.0. ) THEN
pTracer(i,j,k,bi,bj,iTracer) = 1. _d 0
ELSE
pTracer(i,j,k,bi,bj,iTracer) = 0. _d 0
ENDIF
gPtr(i,j,k,bi,bj,iTracer) = 0. _d 0
gPtrNM1(i,j,k,bi,bj,iTracer) = 0. _d 0
ENDDO
ENDDO
ENDDO
DO j=1-Oly,sNy+OLy
DO i=1-Olx,sNx+Olx
surfaceForcingPtr(i,j,bi,bj,iTracer) = 0. _d 0
ENDDO
ENDDO
C end bi,bj loops
ENDDO
ENDDO
C end of Tracer loop
ENDDO
C Now read initial conditions and always exchange
IF (nIter0.EQ.PTRACERS_Iter0) THEN
DO iTracer = 1, PTRACERS_numInUse
IF ( PTRACERS_initialFile(iTracer) .NE. ' ' ) THEN
_BEGIN_MASTER( myThid )
CALL READ_FLD_XYZ_RL(PTRACERS_initialFile(iTracer),' ',
& pTracer(1-Olx,1-Oly,1,1,1,iTracer) ,0,myThid)
_END_MASTER(myThid)
C Apply mask
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO K=1,Nr
DO J=1,sNy
DO I=1,sNx
IF(hFacC(I,J,K,bi,bj).EQ.0)
& pTracer(i,j,k,bi,bj,iTracer)=0.
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ELSE
cswdptr -- add ---
cswdptr -- end add ---
ENDIF
_EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,iTracer),myThid)
ENDDO
ENDIF
C Read from a pickup file if needed
IF (nIter0.GT.PTRACERS_Iter0) THEN
C Suffix for pickup files
IF (pickupSuff.EQ.' ') THEN
WRITE(suff,'(I10.10)') nIter0
ELSE
WRITE(suff,'(A10)') pickupSuff
ENDIF
CALL PTRACERS_READ_CHECKPOINT( nIter0,myThid )
ENDIF
#endif /* ALLOW_PTRACERS */
RETURN
END