pkg/ptracers/ptracers_init.F

C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_init.F,v 1.13 2005/11/08 15:53:41 cnh 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
            pTracer(i,j,k,bi,bj,iTracer) = PTRACERS_ref(k,iTracer)
            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

      _BARRIER

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)                  
         _EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,iTracer),myThid)
        ENDIF
       ENDDO
      ENDIF

C     Apply mask
      DO iTracer = 1, PTRACERS_numInUse
       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
      ENDDO

      _BARRIER
      
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
1	jmc	1.14	C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_init.F,v 1.13 2005/11/08 15:53:41 cnh Exp $
2	stephd	1.2	C $Name: $
3	adcroft	1.1
4			#include "PTRACERS_OPTIONS.h"
5	heimbach	1.3	#ifdef ALLOW_GCHEM
6			# include "GCHEM_OPTIONS.h"
7			#endif
8	adcroft	1.1
9	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
10	adcroft	1.1	CBOP
11	edhill	1.10	C !ROUTINE: PTRACERS_INIT
12	adcroft	1.1
13	edhill	1.10	C !INTERFACE:
14	adcroft	1.1	SUBROUTINE PTRACERS_INIT( myThid )
15
16	edhill	1.10	C !DESCRIPTION:
17	adcroft	1.1	C Initialize PTRACERS data structures
18
19	edhill	1.10	C !USES:
20	adcroft	1.1	IMPLICIT NONE
21			#include "SIZE.h"
22			#include "EEPARAMS.h"
23			#include "PARAMS.h"
24	heimbach	1.3	#include "GRID.h"
25	jmc	1.8	#include "PTRACERS_SIZE.h"
26	adcroft	1.1	#include "PTRACERS.h"
27	stephd	1.2
28	edhill	1.10	C !INPUT PARAMETERS:
29			C myThid :: thread number
30	adcroft	1.1	INTEGER myThid
31
32			#ifdef ALLOW_PTRACERS
33
34	edhill	1.10	C !LOCAL VARIABLES:
35			C i,j,k,bi,bj,iTracer :: loop indices
36	adcroft	1.1	INTEGER i,j,k,bi,bj,iTracer
37	heimbach	1.3	CHARACTER*(10) suff
38	adcroft	1.1	CEOP
39	heimbach	1.3
40	edhill	1.10	C Loop over tracers
41	adcroft	1.1	DO iTracer = 1, PTRACERS_num
42
43	mlosch	1.12	C Loop over tiles
44			DO bj = myByLo(myThid), myByHi(myThid)
45			DO bi = myBxLo(myThid), myBxHi(myThid)
46
47			C Initialize arrays in common blocks :
48			DO k=1,Nr
49			DO j=1-Oly,sNy+OLy
50			DO i=1-Olx,sNx+Olx
51			pTracer(i,j,k,bi,bj,iTracer) = PTRACERS_ref(k,iTracer)
52			gPtr(i,j,k,bi,bj,iTracer) = 0. _d 0
53			gPtrNM1(i,j,k,bi,bj,iTracer) = 0. _d 0
54			ENDDO
55			ENDDO
56			ENDDO
57			DO j=1-Oly,sNy+OLy
58			DO i=1-Olx,sNx+Olx
59			surfaceForcingPtr(i,j,bi,bj,iTracer) = 0. _d 0
60	dimitri	1.7	ENDDO
61	mlosch	1.12	ENDDO
62
63			C end bi,bj loops
64	dimitri	1.6	ENDDO
65	mlosch	1.12	ENDDO
66	adcroft	1.1
67	mlosch	1.12	C end of Tracer loop
68	adcroft	1.1	ENDDO
69
70	cnh	1.13	_BARRIER
71
72	edhill	1.10	C Now read initial conditions and always exchange
73	jmc	1.11	IF (nIter0.EQ.PTRACERS_Iter0) THEN
74	mlosch	1.12	DO iTracer = 1, PTRACERS_numInUse
75			IF ( PTRACERS_initialFile(iTracer) .NE. ' ' ) THEN
76			_BEGIN_MASTER( myThid )
77			CALL READ_FLD_XYZ_RL(PTRACERS_initialFile(iTracer),' ',
78			& pTracer(1-Olx,1-Oly,1,1,1,iTracer),0,myThid)
79			_END_MASTER(myThid)
80			_EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,iTracer),myThid)
81			ENDIF
82			ENDDO
83	adcroft	1.1	ENDIF
84
85	mlosch	1.12	C Apply mask
86			DO iTracer = 1, PTRACERS_numInUse
87			DO bj = myByLo(myThid), myByHi(myThid)
88			DO bi = myBxLo(myThid), myBxHi(myThid)
89			DO K=1,Nr
90			DO J=1,sNy
91			DO I=1,sNx
92			IF(hFacC(I,J,K,bi,bj).EQ.0)
93			& pTracer(i,j,k,bi,bj,iTracer)=0.
94			ENDDO
95			ENDDO
96			ENDDO
97			ENDDO
98			ENDDO
99			ENDDO
100	cnh	1.13
101			_BARRIER
102	mlosch	1.12
103	dimitri	1.6	C Read from a pickup file if needed
104	jmc	1.11	IF (nIter0.GT.PTRACERS_Iter0) THEN
105	mlosch	1.12	C Suffix for pickup files
106			IF (pickupSuff.EQ.' ') THEN
107			WRITE(suff,'(I10.10)') nIter0
108			ELSE
109			WRITE(suff,'(A10)') pickupSuff
110			ENDIF
111			CALL PTRACERS_READ_CHECKPOINT( nIter0,myThid )
112	adcroft	1.1	ENDIF
113	mlosch	1.12
114	adcroft	1.1	#endif /* ALLOW_PTRACERS */
115	mlosch	1.12
116	adcroft	1.1	RETURN
117			END