/[MITgcm]/MITgcm/verification/global_with_CFC11/code1x1/ini_tr1.F
ViewVC logotype

Diff of /MITgcm/verification/global_with_CFC11/code1x1/ini_tr1.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by dimitri, Thu Aug 25 16:22:17 2005 UTC revision 1.1.2.2 by dimitri, Thu Aug 25 18:21:17 2005 UTC
# Line 0  Line 1 
1    C $Header$
2    C $Name$
3    
4    #include "CPP_OPTIONS.h"
5    
6    CBOP
7    C     !ROUTINE: INI_TR1
8    C     !INTERFACE:
9          SUBROUTINE INI_TR1( myThid )
10    C     !DESCRIPTION: \bv
11    C     *==========================================================*
12    C     | SUBROUTINE INI_TR1                                        
13    C     | o Set initial tracer 1 distribution.                      
14    C     *==========================================================*
15    C     | Passive tracers 1-N can be initialised so as to dye fluid.                                                
16    C     | This routine is hardcoded for OCMIP CFC-11 experiment.
17    C     *==========================================================*
18    C     \ev
19    
20    C     !USES:
21          IMPLICIT NONE
22    C     === Global variables ===
23    #include "SIZE.h"
24    #include "EEPARAMS.h"
25    #include "PARAMS.h"
26    #include "GRID.h"
27    #include "DYNVARS.h"
28    #ifdef ALLOW_PASSIVE_TRACER
29    #include "TR1.h"
30    #endif
31    
32    C     !INPUT/OUTPUT PARAMETERS:
33    C     == Routine arguments ==
34    C     myThid -  Number of this instance of INI_TR1
35          INTEGER myThid
36    
37    #ifdef ALLOW_PASSIVE_TRACER
38    
39    C     !LOCAL VARIABLES:
40    C     == Local variables ==
41    C     iC, jC - Center of domain
42    C     iD, jD - Disitance from domain center.
43    C     rad    - Radius of initial patch
44    C     rD     - Radial displacement of point I,J
45    C     iG, jG - Global coordinate index
46    C     bi,bj  - Loop counters
47    C     I,J,K
48          INTEGER iC, jC, iD, jD
49          INTEGER iG, jG
50          INTEGER bi, bj
51          INTEGER I, J, K, localWarnings
52          _RL     rad, rD
53          CHARACTER*(MAX_LEN_MBUF) msgBuf
54    CEOP
55    
56          _BARRIER
57    
58    C--   Initialise tracer to inline.
59          DO bj = myByLo(myThid), myByHi(myThid)
60           DO bi = myBxLo(myThid), myBxHi(myThid)
61            DO K=1,Nr
62             DO J=1,sNy
63              DO I=1,sNx
64                tr1(I,J,K,bi,bj) = 0. _d 0
65              ENDDO
66             ENDDO
67            ENDDO
68           ENDDO
69          ENDDO
70    C     Set initial tendency terms
71          localWarnings=0
72          DO bj = myByLo(myThid), myByHi(myThid)
73           DO bi = myBxLo(myThid), myBxHi(myThid)
74            DO K=1,Nr
75             DO J=1,sNy
76              DO I=1,sNx
77               gtr1   (I,J,K,bi,bj) = 0. _d 0
78               gtr1NM1(I,J,K,bi,bj) = 0. _d 0
79              ENDDO
80             ENDDO
81            ENDDO
82           ENDDO
83          ENDDO
84    C
85          _EXCH_XYZ_R8(tr1 , myThid )
86          _EXCH_XYZ_R8(gtr1 , myThid )
87          _EXCH_XYZ_R8(gtr1NM1 , myThid )
88    
89          CALL PLOT_FIELD_XYZRL( tr1, 'Initial TR1' ,
90         &                       Nr, 1, myThid )
91    
92    C--   Input file names
93          FiceFile = 'FICE'
94          XkwFile  = 'XKW'
95          PatmFile = 'PATM'
96    
97    C--   Compute numbers need to determine pCFC
98          CALL read_cfcatm
99          DO bj = myByLo(myThid), myByHi(myThid)
100           DO bi = myBxLo(myThid), myBxHi(myThid)
101            DO J=1,sNy
102             DO I=1,sNx
103              IF     ( yC(I,J,bi,bj) .GE.  10. ) THEN
104               pCFCw1(I,J,bi,bj) = 1.
105               pCFCw2(I,J,bi,bj) = 0.
106              ELSEIF ( yC(I,J,bi,bj) .LE. -10. ) THEN
107               pCFCw1(I,J,bi,bj) = 0.
108               pCFCw2(I,J,bi,bj) = 1.
109              ELSE
110               pCFCw1(I,J,bi,bj) = ( yC(I,J,bi,bj) + 10. ) / 20.
111               pCFCw2(I,J,bi,bj) = ( 10. - yC(I,J,bi,bj) ) / 20.
112              ENDIF
113             ENDDO
114            ENDDO
115           ENDDO
116          ENDDO
117          _EXCH_XY_R8(pCFCw1 , myThid )
118          _EXCH_XY_R8(pCFCw2 , myThid )
119    
120    #endif /*  ALLOW_PASSIVE_TRACER */
121    
122          RETURN
123          END
124    
125    C====================================================================
126    
127    c_ ---------------------------------------------------------------------
128    c_ RCS lines preceded by "c_ "
129    c_ ---------------------------------------------------------------------
130    c_
131    c_ $Source$
132    c_ $Revision$
133    c_ $Date$   ;  $State$
134    c_ $Author$ ;  $Locker$
135    c_
136    c_ ---------------------------------------------------------------------
137    c_ $Log$
138    c_ Revision 1.1.2.2  2005/08/25 18:21:17  dimitri
139    c_ updating verification/global_with_CFC11/code1x1/external_forcing_tr.F
140    c_ and verification/global_with_CFC11/code1x1/ini_tr1.F
141    c_ for release1_50yr
142    c_
143    c_ Revision 1.1.2.1  2005/08/25 16:22:17  dimitri
144    c_ adding ecco1x1 verification/global_with_CFC11 experiment
145    c_
146    c_ Revision 1.1.2.1  2003/05/03 04:27:34  dimitri
147    c_ Branched off release1_p15
148    c_ Modified pkg/exf/exf_clim_param.h, exf_clim_readparms.F,
149    c_    exf_set_climsss.F, and exf_set_climsst.F to add exf_interp
150    c_    capability to SST and SSS
151    c_ Added verification/global_with_CFC11/code50yr and input50yr
152    c_
153    c_ Revision 1.1.2.1  2003/05/01 18:18:29  dimitri
154    c_ release1_p15
155    c_ o Added CFC-11 diagnostics, see
156    c_   verification/global_with_CFC11/README
157    c_
158    c_ Revision 1.2  1998/07/20 15:33:32  jomce
159    c_ Used new data set from Walker et al. (sent by J. Bullister 17/7/1998)
160    c_ from mid 1931 to mid 1997.  Format of cfc1112.atm has changed.  This
161    c_ file modified accordingly, and old atm record moved to old/cfc1112.atm.old
162    c_
163    c_ Revision 1.1  1998/07/07 15:22:00  orr
164    c_ Initial revision
165    c_
166    c_ ---------------------------------------------------------------------
167    c_
168          SUBROUTINE read_cfcatm
169    
170    C     --------------------------------------------------------------------
171    C     Reads temporal history of atmospheric CFC-11 and CFC-12 (both in pptv)
172    C
173    C     year         = year of measurement (mid-year)
174    C     p11(year,nt) = pcfc11  in northern (1) and southern (2) hemisphere
175    C     p12(year,nt) = pcfc12  in northern (1) and southern (2) hemisphere
176    C     --------------------------------------------------------------------
177    
178    c      Jean-Claude Dutay, LSCE/CEA-CNRS, Saclay, France, 10 May 1998
179    c      - modfied by J. Orr (9 June 1998)
180    
181          IMPLICIT NONE
182    #include "SIZE.h"
183    #include "EEPARAMS.h"
184    #include "TR1.h"
185    
186          INTEGER i, n, iu
187          PARAMETER (iu=10)
188    
189          CHARACTER*80 filen
190    C
191    C     OPEN FILE
192    C     ---------
193          filen='cfc1112.atm'
194          OPEN(UNIT=iu,FILE=filen,STATUS='old')
195    c
196    c     Skip over 1st six descriptor lines
197    c     ----------------------------------
198          DO i=1,6
199            READ(iu,99)
200          END do    
201    
202    C
203    C     READ FILE
204    C     ---------
205          DO n = nyrbeg, nyrend
206            READ(iu,*)
207         +      CFCyear(n), CFCp11(n,1), CFCp12(n,1)
208         +     ,            CFCp11(n,2), CFCp12(n,2)
209            WRITE(6,100)
210         +      CFCyear(n), CFCp11(n,1), CFCp12(n,1)
211         +     ,            CFCp11(n,2), CFCp12(n,2)
212          END DO
213    
214     99   FORMAT(1x)
215     100  FORMAT(f7.2, 4f8.2)
216    
217          RETURN
218          END

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.2.2

  ViewVC Help
Powered by ViewVC 1.1.22