/[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.5 - (hide annotations) (download)
Thu Jun 20 21:47:20 2013 UTC (12 years, 1 month ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt64k_20130723, ctrb_darwin2_ckpt64m_20130820, ctrb_darwin2_ckpt64r_20131210, ctrb_darwin2_ckpt64n_20130826, ctrb_darwin2_ckpt64o_20131024, ctrb_darwin2_ckpt64i_20130622, ctrb_darwin2_ckpt64l_20130806, ctrb_darwin2_ckpt64j_20130704, ctrb_darwin2_ckpt64p_20131118, ctrb_darwin2_ckpt64q_20131118, ctrb_darwin2_ckpt64p_20131024
Changes since 1.4: +16 -4 lines
quota: fix io units for CHECK_CONS and pick more descriptive names

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.4 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     c CALL TIMEAVE_RESET(SURave, 1, bi, bj, myThid)
298     WRITE(msgbuf,'(A)')
299     & 'QQ start timeave'
300     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
301     & SQUEEZE_RIGHT , mythid)
302    
303     do k=1,Nr
304     DAR_TimeAve(bi,bj,k)=0. _d 0
305     enddo
306     ENDDO
307     ENDDO
308     #endif /* ALLOW_TIMEAVE */
309    
310     #ifdef CHECK_CONS
311     coj find unused units for darwin_cons output
312 jahn 1.5 CALL MDSFINDUNIT( DAR_cons_unitC, mythid )
313     open(DAR_cons_unitC,file='darwin_cons_C.txt',status='unknown')
314     CALL MDSFINDUNIT( DAR_cons_unitN, mythid )
315     open(DAR_cons_unitN,file='darwin_cons_N.txt',status='unknown')
316     #ifdef PQUOTA
317     CALL MDSFINDUNIT( DAR_cons_unitP, mythid )
318     open(DAR_cons_unitP,file='darwin_cons_P.txt',status='unknown')
319     #endif
320     #ifdef FQUOTA
321     CALL MDSFINDUNIT( DAR_cons_unitF, mythid )
322     open(DAR_cons_unitF,file='darwin_cons_Fe.txt',status='unknown')
323     #endif
324     #ifdef SQUOTA
325     CALL MDSFINDUNIT( DAR_cons_unitS, mythid )
326     open(DAR_cons_unitS,file='darwin_cons_Si.txt',status='unknown')
327     #endif
328 jahn 1.1 #endif
329    
330     c test....................
331     c write(6,*)'finishing darwin_init_vari '
332     c test....................
333     WRITE(msgBuf,'(A)')
334     & '// ======================================================='
335     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
336     & SQUEEZE_RIGHT, myThid )
337     WRITE(msgBuf,'(A)') '// Darwin init variables >>> END <<<'
338     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
339     & SQUEEZE_RIGHT, myThid )
340     WRITE(msgBuf,'(A)')
341     & '// ======================================================='
342     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
343     & SQUEEZE_RIGHT, myThid )
344    
345     RETURN
346     END
347     #endif /*ALLOW_QUOTA*/
348     #endif /*ALLOW_DARWIN*/
349     #endif /*ALLOW_PTRACERS*/
350     c ==========================================================
351    

  ViewVC Help
Powered by ViewVC 1.1.22