/[MITgcm]/MITgcm_contrib/darwin2/pkg/quota/quota_init_vari.F
ViewVC logotype

Annotation of /MITgcm_contrib/darwin2/pkg/quota/quota_init_vari.F

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


Revision 1.2 - (hide annotations) (download)
Fri May 13 14:55:12 2011 UTC (14 years, 2 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt63l_20120405, ctrb_darwin2_ckpt63f_20111201, ctrb_darwin2_ckpt62y_20110526, ctrb_darwin2_ckpt62x_20110513, ctrb_darwin2_ckpt63o_20120629, ctrb_darwin2_ckpt63c_20111011, ctrb_darwin2_ckpt63i_20120124, ctrb_darwin2_ckpt63m_20120506, ctrb_darwin2_ckpt63e_20111107, ctrb_darwin2_ckpt63b_20110830, ctrb_darwin2_ckpt63j_20120217, ctrb_darwin2_ckpt63g_20111220, ctrb_darwin2_ckpt63a_20110804, ctrb_darwin2_ckpt63h_20111230, ctrb_darwin2_ckpt63d_20111107, ctrb_darwin2_ckpt63_20110728, ctrb_darwin2_ckpt63n_20120604, ctrb_darwin2_ckpt63k_20120317, ctrb_darwin2_ckpt62z_20110622
Changes since 1.1: +1 -1 lines
fix typo in unit number variable

1 jahn 1.1 C $Name: $
2    
3     #include "CPP_OPTIONS.h"
4     #include "DARWIN_OPTIONS.h"
5    
6     #ifdef ALLOW_PTRACERS
7     #ifdef ALLOW_DARWIN
8     #ifdef ALLOW_QUOTA
9    
10     c ==========================================================
11     c SUBROUTINE QUOTA_INIT_VARI()
12     c initialize stuff for generalized quota plankton model
13     c adapted from NPZD2Fe - Mick Follows, Fall 2005
14     c modified - Stephanie Dutkiewicz, Spring 2006
15     c modified - Ben Ward, 2009/2010
16     c ==========================================================
17     c
18     SUBROUTINE QUOTA_INIT_VARI(myThid)
19    
20     IMPLICIT NONE
21    
22     #include "SIZE.h"
23     #include "GRID.h"
24     #include "DYNVARS.h"
25     #include "EEPARAMS.h"
26     #include "PARAMS.h"
27     #include "QUOTA_SIZE.h"
28     #include "QUOTA.h"
29     c#include "GCHEM.h"
30     #include "DARWIN_IO.h"
31    
32     C !INPUT PARAMETERS: ===================================================
33     C myThid :: thread number
34     INTEGER myThid
35    
36     C === Functions ===
37     _RL DARWIN_RANDOM
38     EXTERNAL DARWIN_RANDOM
39    
40     C !LOCAL VARIABLES:
41     C === Local variables ===
42     C msgBuf - Informational/error meesage buffer
43     CHARACTER*(MAX_LEN_MBUF) msgBuf
44     CHARACTER*(MAX_LEN_MBUF) char_str
45     INTEGER char_n
46     INTEGER IniUnit1, IniUnit2, IniUnit3, IniUnit4, IniUnit5
47    
48     INTEGER bi, bj, k, i, j, iPAR
49     INTEGER ii,io,jp,jp2,ko
50     _RL pday
51     c length of day (seconds)
52     pday = 86400.0 _d 0
53     CEOP
54    
55     WRITE(msgBuf,'(A)')
56     & '// ======================================================='
57     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
58     & SQUEEZE_RIGHT, myThid )
59     WRITE(msgBuf,'(A)') '// Quota init variables >>> START <<<'
60     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
61     & SQUEEZE_RIGHT, myThid )
62     WRITE(msgBuf,'(A)')
63     & '// ======================================================='
64     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
65     & SQUEEZE_RIGHT, myThid )
66    
67     c test....................
68     c write(6,*)'testing in npzd2fe_init_vari '
69     c test....................
70    
71    
72     c set up ecosystem coefficients
73     c
74    
75     c initialize total number of functional groups tried
76     ngroups = 0
77     CALL quota_generate_phyto(MyThid)
78     c %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
79    
80     c %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
81     c %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
82     c write out initial plankton and organic matter characteristics
83     CALL MDSFINDUNIT( IniUnit1, mythid )
84     open(IniUnit1,file='plankton-ini-char.dat',status='unknown')
85     CALL MDSFINDUNIT( IniUnit2, mythid )
86     open(IniUnit2,file='plankton_ini_char_nohead.dat',
87     & status='unknown')
88     c-----------------------------------------------
89     char_str=' pft bio_vol qcarbon'
90     & //' biosink bioswim mortality'
91     & //' respiration autotrophy pp_opt'
92     char_n=108
93     c loop elements
94     do ii=1,iimax
95     WRITE(msgBuf,'(I1)'),ii
96     char_str=char_str(1:char_n)//' vmaxi_'//msgBuf(1:1)
97     char_n=char_n+12
98     enddo
99     do ii=2,iimax ! skip carbon
100     WRITE(msgBuf,'(I1)'),ii
101     char_str=char_str(1:char_n)//' kn_'//msgBuf(1:1)
102     char_n=char_n+12
103     enddo
104     c loop quotas
105     do io=2,iomax-iChl ! skip carbon
106     WRITE(msgBuf,'(I1)'),io
107     char_str=char_str(1:char_n)//' qmin_'//msgBuf(1:1)
108     & //' qmax_'//msgBuf(1:1)
109     char_n=char_n+24
110     enddo
111     do io=1,iomax-iChl
112     WRITE(msgBuf,'(I1)'),io
113     if (io.eq.iCarb.or.io.eq.iNitr.or.io.eq.iPhos) then
114     char_str=char_str(1:char_n)//' excretn_'//msgBuf(1:1)
115     char_n=char_n+12
116     endif
117     char_str=char_str(1:char_n)//' beta_mort_'//msgBuf(1:1)
118     & //' beta_graz_'//msgBuf(1:1)
119     char_n=char_n+24
120     enddo
121     c
122     char_str=char_str(1:char_n)//' alphachl'
123     & //' maxgraz k_graz'
124     char_n=char_n+36
125     write(IniUnit1,'(A)'),char_str(1:char_n)
126     c-----------------------------------------------
127     do jp = 1, npmax
128     write(msgBuf,120)float(pft(jp)),biovol(jp),qcarbon(jp),
129     & biosink(jp)*pday,bioswim(jp)*pday,kmort(jp)*pday,
130     & respiration(jp)*pday,autotrophy(jp),pp_opt(jp)
131     char_str=msgBuf
132     char_n=108
133     c loop elements
134     do ii=1,iimax
135     write(msgBuf,111)vmaxi(ii,jp)*pday
136     char_str=char_str(1:char_n)//msgBuf
137     char_n=char_n+12
138     enddo
139     do ii=2,iimax ! skip carbon
140     write(msgBuf,111)kn(ii,jp)
141     char_str=char_str(1:char_n)//msgBuf
142     char_n=char_n+12
143     enddo
144     c loop quotas
145     do io=2,iomax-iChl ! skip carbon
146     write(msgBuf,112)qmin(io,jp),qmax(io,jp)
147     char_str=char_str(1:char_n)//msgBuf
148     char_n=char_n+24
149     enddo
150     do io=1,iomax-iChl
151     if (io.eq.iCarb.or.io.eq.iNitr.or.io.eq.iPhos) then
152     write(msgBuf,111)kexc(io,jp)*pday
153     char_str=char_str(1:char_n)//msgBuf
154     char_n=char_n+12
155     endif
156     write(msgBuf,112)beta_mort(io,jp),beta_graz(io,jp)
157     char_str=char_str(1:char_n)//msgBuf
158     char_n=char_n+24
159     enddo
160     write(msgBuf,113)alphachl(jp),
161     & graz(jp)*pday,kg(jp)
162     char_str=char_str(1:char_n)//msgBuf
163     char_n=char_n+36
164     c-----------------------------------------------
165     write(IniUnit1,'(A)')char_str(1:char_n)
166     write(IniUnit2,'(A)')char_str(1:char_n)
167     enddo
168     c<><><><><><><><><><><><><><><><><><><><><><><><><><>
169     close(IniUnit2)
170     close(IniUnit1)
171     c-----------------------------------------------
172     c write out grazing max rate and half sat matrices
173     CALL MDSFINDUNIT( IniUnit3, mythid )
174     open(IniUnit3,file='plankton-grazing.dat',status='unknown')
175     ! max ingestion rates
176     do jp=1,npmax
177     char_n=0
178     do jp2=1,npmax
179     write(msgBuf,'(e9.3)')graz(jp)*pday
180     char_str=char_str(1:char_n)//msgBuf(1:10)
181     char_n=char_n+10
182     enddo
183     write(IniUnit3,'(A)')char_str(1:char_n)
184     enddo
185     char_n=0
186     do jp2=1,npmax
187     char_str=char_str(1:char_n)//'----------'
188     char_n=char_n+10
189     enddo
190     write(IniUnit3,'(A)')char_str(1:char_n)
191     ! 1/2-saturations
192     do jp=1,npmax
193     char_n=0
194     do jp2=1,npmax
195     write(msgBuf,'(e9.3)')kg(jp)
196     char_str=char_str(1:char_n)//msgBuf(1:10)
197     char_n=char_n+10
198     enddo
199     write(IniUnit3,'(A)')char_str(1:char_n)
200     enddo
201     char_n=0
202     do jp2=1,npmax
203     char_str=char_str(1:char_n)//'----------'
204     char_n=char_n+10
205     enddo
206     write(IniUnit3,'(A)')char_str(1:char_n)
207     ! predator prey-preference
208     do jp=1,npmax
209     char_n=0
210     do jp2=1,npmax
211     write(msgBuf,'(e9.3)')graz_pref(jp,jp2)
212     char_str=char_str(1:char_n)//msgBuf(1:10)
213     char_n=char_n+10
214     enddo
215     write(IniUnit3,'(A)')char_str(1:char_n)
216     enddo
217     c<><><><><><><><><><><><><><><><><><><><><><><><><><>
218     close(IniUnit3)
219     c-----------------------------------------------
220     c write out organic matter remineralisation rates
221 jahn 1.2 CALL MDSFINDUNIT( IniUnit4, mythid )
222 jahn 1.1 open(IniUnit4,file='plankton-orgmat.dat',status='unknown')
223     ! DOM remineralisation rates
224     char_n=0
225     do io=1,iomax-iChl
226     if (io.ne.iSili) then
227     write(msgBuf,'(e9.3)')remin(io,1)*pday
228     char_str=char_str(1:char_n)//msgBuf(1:10)
229     endif
230     char_n=char_n+10
231     enddo
232     write(IniUnit4,'(A)')char_str(1:char_n)
233     ! POM remineralisation rates
234     char_n=0
235     do io=1,iomax-iChl
236     write(msgBuf,'(e9.3)')remin(io,2)*pday
237     char_str=char_str(1:char_n)//msgBuf(1:10)
238     char_n=char_n+10
239     enddo
240     write(IniUnit4,'(A)')char_str(1:char_n)
241     c<><><><><><><><><><><><><><><><><><><><><><><><><><>
242     close(IniUnit4)
243     c-----------------------------------------------
244     111 format(1e12.4)
245     112 format(2e12.4)
246     113 format(3e12.4)
247     114 format(4e12.4)
248     115 format(5e12.4)
249     116 format(6e12.4)
250     118 format(8e12.4)
251     120 format(10e12.4)
252     c %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
253     c %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
254     CALL LEF_ZERO( inputFe,myThid )
255     CALL LEF_ZERO( sur_par,myThid )
256     #ifdef NUT_SUPPLY
257     DO bj = myByLo(myThid), myByHi(myThid)
258     DO bi = myBxLo(myThid), myBxHi(myThid)
259     DO j=1-Oly,sNy+Oly
260     DO i=1-Olx,sNx+Olx
261     DO k=1,nR
262     nut_wvel(i,j,k,bi,bj) = 0. _d 0
263     ENDDO
264     ENDDO
265     ENDDO
266     ENDDO
267     ENDDO
268     #endif
269    
270     #ifdef ALLOW_PAR_DAY
271     DO iPAR=1,2
272     DO bj=myByLo(myThid), myByHi(myThid)
273     DO bi=myBxLo(myThid), myBxHi(myThid)
274     DO k=1,nR
275     DO j=1-Oly,sNy+Oly
276     DO i=1-Olx,sNx+Olx
277     PARday(i,j,k,bi,bj,iPAR) = 0. _d 0
278     ENDDO
279     ENDDO
280     ENDDO
281     ENDDO
282     ENDDO
283     ENDDO
284     IF ( .NOT. ( startTime .EQ. baseTime .AND. nIter0 .EQ. 0
285     & .AND. pickupSuff .EQ. ' ') ) THEN
286     COJ should probably initialize from a file when nIter0 .EQ. 0
287     CALL DARWIN_READ_PICKUP( nIter0, myThid )
288     ENDIF
289     #endif
290     c
291     #ifdef ALLOW_TIMEAVE
292     c set arrays to zero if first timestep
293     DO bj = myByLo(myThid), myByHi(myThid)
294     DO bi = myBxLo(myThid), myBxHi(myThid)
295     CALL TIMEAVE_RESET(PARave, Nr, bi, bj, myThid)
296     CALL TIMEAVE_RESET(PPave, Nr, bi, bj, myThid)
297     #ifdef DAR_DIAG_DIVER
298     CALL TIMEAVE_RESET(Diver1ave, Nr, bi, bj, myThid)
299     CALL TIMEAVE_RESET(Diver2ave, Nr, bi, bj, myThid)
300     CALL TIMEAVE_RESET(Diver3ave, Nr, bi, bj, myThid)
301     CALL TIMEAVE_RESET(Diver4ave, Nr, bi, bj, myThid)
302     #endif
303     c CALL TIMEAVE_RESET(SURave, 1, bi, bj, myThid)
304     WRITE(msgbuf,'(A)')
305     & 'QQ start timeave'
306     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
307     & SQUEEZE_RIGHT , mythid)
308    
309     do k=1,Nr
310     DAR_TimeAve(bi,bj,k)=0. _d 0
311     enddo
312     ENDDO
313     ENDDO
314     #endif /* ALLOW_TIMEAVE */
315    
316     #ifdef CHECK_CONS
317     coj find unused units for darwin_cons output
318     CALL MDSFINDUNIT( DAR_cons_unit1, mythid )
319     open(DAR_cons_unit1,file='darwin_cons_C.txt',status='unknown')
320     CALL MDSFINDUNIT( DAR_cons_unit2, mythid )
321     open(DAR_cons_unit2,file='darwin_cons_N.txt',status='unknown')
322     #endif
323    
324     c test....................
325     c write(6,*)'finishing darwin_init_vari '
326     c test....................
327     WRITE(msgBuf,'(A)')
328     & '// ======================================================='
329     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
330     & SQUEEZE_RIGHT, myThid )
331     WRITE(msgBuf,'(A)') '// Darwin init variables >>> END <<<'
332     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
333     & SQUEEZE_RIGHT, myThid )
334     WRITE(msgBuf,'(A)')
335     & '// ======================================================='
336     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
337     & SQUEEZE_RIGHT, myThid )
338    
339     RETURN
340     END
341     #endif /*ALLOW_QUOTA*/
342     #endif /*ALLOW_DARWIN*/
343     #endif /*ALLOW_PTRACERS*/
344     c ==========================================================
345    

  ViewVC Help
Powered by ViewVC 1.1.22