pkg/ptracers/ptracers_init_varia.F

C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_init_varia.F,v 1.7 2009/04/28 18:18:29 jmc Exp $
C $Name:  $

#include "PTRACERS_OPTIONS.h"
#include "GAD_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: PTRACERS_INIT_VARIA

C     !INTERFACE:
      SUBROUTINE PTRACERS_INIT_VARIA( myThid )

C     !DESCRIPTION:
C     Initialize PTRACERS data structures

C     !USES:
#include "PTRACERS_MOD.h"
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "GAD.h"
#include "PTRACERS_SIZE.h"
#include "PTRACERS_PARAMS.h"
#include "PTRACERS_FIELDS.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,n
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

#ifdef PTRACERS_ALLOW_DYN_STATE
C     Initialize SOM array :
         IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
           DO n = 1,nSOM
            DO k=1,Nr
             DO j=1-OLy,sNy+OLy
              DO i=1-OLx,sNx+OLx
               _Ptracers_som(i,j,k,bi,bj,n,iTracer) = 0. _d 0
              ENDDO
             ENDDO
            ENDDO
           ENDDO
         ENDIF
#endif /* PTRACERS_ALLOW_DYN_STATE */

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
         CALL READ_FLD_XYZ_RL(PTRACERS_initialFile(iTracer),' ',
     &        pTracer(1-Olx,1-Oly,1,1,1,iTracer),0,myThid)
         _EXCH_XYZ_RL(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-OLy,sNy+OLy
           DO i=1-OLx,sNx+OLx
            IF (maskC(i,j,k,bi,bj).EQ.0.)
     &           pTracer(i,j,k,bi,bj,iTracer)=0. _d 0
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO

C Read from a pickup file if needed
      IF ( nIter0.GT.PTRACERS_Iter0 .OR.
     &    (nIter0.EQ.PTRACERS_Iter0 .AND. pickupSuff.NE.' ')
     &   ) THEN

       CALL PTRACERS_READ_PICKUP( nIter0, myThid )
      ENDIF

#endif /* ALLOW_PTRACERS */

      RETURN
      END
1	jmc	1.8	C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_init_varia.F,v 1.7 2009/04/28 18:18:29 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "PTRACERS_OPTIONS.h"
5	jahn	1.5	#include "GAD_OPTIONS.h"
6	jmc	1.1
7			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
8			CBOP
9			C !ROUTINE: PTRACERS_INIT_VARIA
10
11			C !INTERFACE:
12			SUBROUTINE PTRACERS_INIT_VARIA( myThid )
13
14			C !DESCRIPTION:
15			C Initialize PTRACERS data structures
16
17			C !USES:
18	jahn	1.5	#include "PTRACERS_MOD.h"
19	jmc	1.1	IMPLICIT NONE
20			#include "SIZE.h"
21			#include "EEPARAMS.h"
22			#include "PARAMS.h"
23			#include "GRID.h"
24	jahn	1.5	#include "GAD.h"
25	jmc	1.1	#include "PTRACERS_SIZE.h"
26	jmc	1.4	#include "PTRACERS_PARAMS.h"
27			#include "PTRACERS_FIELDS.h"
28	jmc	1.1
29			C !INPUT PARAMETERS:
30			C myThid :: thread number
31			INTEGER myThid
32
33			#ifdef ALLOW_PTRACERS
34
35			C !LOCAL VARIABLES:
36			C i,j,k,bi,bj,iTracer :: loop indices
37	jahn	1.5	INTEGER i,j,k,bi,bj,iTracer,n
38	jmc	1.1	CEOP
39
40			C Loop over tracers
41			DO iTracer = 1, PTRACERS_num
42
43			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	jmc	1.4	DO j=1-OLy,sNy+OLy
50			DO i=1-OLx,sNx+OLx
51	jmc	1.1	pTracer(i,j,k,bi,bj,iTracer) = PTRACERS_ref(k,iTracer)
52			gPtr(i,j,k,bi,bj,iTracer) = 0. _d 0
53	jmc	1.4	gpTrNm1(i,j,k,bi,bj,iTracer) = 0. _d 0
54	jmc	1.1	ENDDO
55			ENDDO
56			ENDDO
57	jmc	1.4	DO j=1-OLy,sNy+OLy
58			DO i=1-OLx,sNx+OLx
59			surfaceForcingPTr(i,j,bi,bj,iTracer) = 0. _d 0
60	jmc	1.1	ENDDO
61			ENDDO
62
63	jmc	1.6	#ifdef PTRACERS_ALLOW_DYN_STATE
64	jahn	1.5	C Initialize SOM array :
65			IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
66			DO n = 1,nSOM
67			DO k=1,Nr
68			DO j=1-OLy,sNy+OLy
69			DO i=1-OLx,sNx+OLx
70			_Ptracers_som(i,j,k,bi,bj,n,iTracer) = 0. _d 0
71			ENDDO
72			ENDDO
73			ENDDO
74			ENDDO
75			ENDIF
76	jmc	1.6	#endif /* PTRACERS_ALLOW_DYN_STATE */
77	jahn	1.5
78	jmc	1.1	C end bi,bj loops
79			ENDDO
80			ENDDO
81
82			C end of Tracer loop
83			ENDDO
84
85			_BARRIER
86
87			C Now read initial conditions and always exchange
88			IF (nIter0.EQ.PTRACERS_Iter0) THEN
89			DO iTracer = 1, PTRACERS_numInUse
90			IF ( PTRACERS_initialFile(iTracer) .NE. ' ' ) THEN
91			CALL READ_FLD_XYZ_RL(PTRACERS_initialFile(iTracer),' ',
92			& pTracer(1-Olx,1-Oly,1,1,1,iTracer),0,myThid)
93	jmc	1.7	_EXCH_XYZ_RL(pTracer(1-Olx,1-Oly,1,1,1,iTracer),myThid)
94	jmc	1.1	ENDIF
95			ENDDO
96			ENDIF
97
98			C Apply mask
99			DO iTracer = 1, PTRACERS_numInUse
100			DO bj = myByLo(myThid), myByHi(myThid)
101			DO bi = myBxLo(myThid), myBxHi(myThid)
102			DO k=1,Nr
103	jmc	1.4	DO j=1-OLy,sNy+OLy
104			DO i=1-OLx,sNx+OLx
105	jmc	1.1	IF (maskC(i,j,k,bi,bj).EQ.0.)
106			& pTracer(i,j,k,bi,bj,iTracer)=0. _d 0
107			ENDDO
108			ENDDO
109			ENDDO
110			ENDDO
111			ENDDO
112			ENDDO
113
114			C Read from a pickup file if needed
115	jmc	1.8	IF ( nIter0.GT.PTRACERS_Iter0 .OR.
116			& (nIter0.EQ.PTRACERS_Iter0 .AND. pickupSuff.NE.' ')
117			& ) THEN
118
119	jmc	1.3	CALL PTRACERS_READ_PICKUP( nIter0, myThid )
120	jmc	1.1	ENDIF
121
122			#endif /* ALLOW_PTRACERS */
123
124			RETURN
125			END