Blame view

src/extras/bio/bio_save.F90 15.4 KB
33b83817   dumoda01   Depot du modele /...
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
!$Id: bio_save.F90,v 1.8 2007-03-14 12:46:07 kbk Exp $
#include"cppdefs.h"
!-----------------------------------------------------------------------
!BOP
! !ROUTINE: Storing the results
!
! !INTERFACE:
   subroutine bio_save(nlev,totn)
!
! !DESCRIPTION:
! Here, the output of biogeochemical parameters either as ascii or as
! NetCDF files is managed.
!
! !USES:
   use bio_var
4e171ca6   dumoda01   Modification du m...
16
   use output,  only: out_fmt,ts
b15ffe85   Gwenaelle Gremion   Depot initial du ...
17

33b83817   dumoda01   Depot du modele /...
18
19
20
21
22
23
24
25
26
27
28
29
30
31
#ifdef NETCDF_FMT
   use ncdfout, only: ncid
   use ncdfout, only: lon_dim,lat_dim,z_dim,time_dim,dims
   use ncdfout, only: define_mode,new_nc_variable,set_attributes,store_data
#endif
   IMPLICIT NONE
#ifdef NETCDF_FMT
#include "netcdf.inc"
!   use netcdf
#endif
!
! !INPUT PARAMETERS:
   integer, intent(in)                 :: nlev
   REALTYPE, intent(in)                :: totn
b15ffe85   Gwenaelle Gremion   Depot initial du ...
32

33b83817   dumoda01   Depot du modele /...
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
!
! !REVISION HISTORY:
!  Original author(s): Hans Burchard & Karsten Bolding
!
! !LOCAL VARIABLES:
   logical, save             :: first=.true.
   integer, save             :: nn
   integer, save             :: totn_id
   integer                   :: iret
   integer                   :: out_unit=67
   REALTYPE                  :: zz
   integer                   :: i,j,n
!EOP
!-----------------------------------------------------------------------
!BOC
   if (init_saved_vars) then
      init_saved_vars=.false.
      first=.true.
   end if
   select case (out_fmt)
b15ffe85   Gwenaelle Gremion   Depot initial du ...
53
54
55
!-----------------------------------------------------------------------------------
! Ascii format for the output
!-----------------------------------------------------------------------------------
33b83817   dumoda01   Depot du modele /...
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
      case (ASCII)
         if(first) then
            open(out_unit,file='bio.out',status='unknown')
            nn = ubound(cc(1,:),1)
            first = .false.
         end if
         write(out_unit,*)
         write(out_unit,*) trim(ts)
         zz = _ZERO_
         do i=nn,1,-1
            zz=zz+0.5*h(i)
            write(out_unit,115) zz,(cc(j,i) , j=1,numc)
            zz=zz+0.5*h(i)
         end do
115 format(F10.4,100(1x,E10.4E2))

b15ffe85   Gwenaelle Gremion   Depot initial du ...
72
73
74
!-----------------------------------------------------------------------------------
! NETCDF format for the output
!-----------------------------------------------------------------------------------
33b83817   dumoda01   Depot du modele /...
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
      case (NETCDF)
#ifdef NETCDF_FMT
         if(first) then
            first = .false.
            dims(1) = lon_dim
            dims(2) = lat_dim
            dims(3) = z_dim
            dims(4) = time_dim

            iret = define_mode(ncid,.true.)

            do n=1,numc
               iret = new_nc_variable(ncid,var_names(n),NF_REAL, &
                                      4,dims,var_ids(n))
               iret = set_attributes(ncid,var_ids(n),       &
                                     units=var_units(n),    &
                                     long_name=var_long(n))
            end do
b15ffe85   Gwenaelle Gremion   Depot initial du ...
93
94
95
96
!-----------------------------------------------------------------------------------
!Prepare the new variable for the NETCDF output file as well as informations
!-----------------------------------------------------------------------------------
    
b15ffe85   Gwenaelle Gremion   Depot initial du ...
97
98
99
100
!Density of the fluid at each level
            iret = new_nc_variable(ncid,'rho',NF_REAL,4,dims,rho_id)
            iret = set_attributes(ncid,rho_id,units='kg.m-3',long_name='Density')

b15ffe85   Gwenaelle Gremion   Depot initial du ...
101
! Sedimentation or swimming rate of particulate matter
8465f2a2   Dany Dumont   migration vertica...
102
            ! Living phytoplankton
33b83817   dumoda01   Depot du modele /...
103
104
            iret = new_nc_variable(ncid,'wp',NF_REAL,4,dims,wp_id)
            iret = set_attributes(ncid,wp_id,units='m/day', &
e48ad91f   Gwenaelle Gremion   Clarification de ...
105
                                  long_name='Phytoplancton settling velocity')
b15ffe85   Gwenaelle Gremion   Depot initial du ...
106

e48ad91f   Gwenaelle Gremion   Clarification de ...
107
           ! Living zooplankton
b15ffe85   Gwenaelle Gremion   Depot initial du ...
108
        !Nocera Model
8465f2a2   Dany Dumont   migration vertica...
109
110
111
112
113
            if (bio_model .eq. 8) then
               iret = new_nc_variable(ncid,'wz',NF_REAL,4,dims,wz_id)
               iret = set_attributes(ncid,wz_id,units='m/day', &
                                  long_name='zooplancton swimming velocity')
            end if
b15ffe85   Gwenaelle Gremion   Depot initial du ...
114
115
116
117
118
119
         
         !Polynow model
            if (bio_model .eq. 10) then
            ! Living zooplankton
               iret = new_nc_variable(ncid,'wz',NF_REAL,4,dims,wz_id)
               iret = set_attributes(ncid,wz_id,units='m/day', &
e48ad91f   Gwenaelle Gremion   Clarification de ...
120
                                  long_name='Zooplancton swimming velocity')
b15ffe85   Gwenaelle Gremion   Depot initial du ...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
            ! Dead Phytoplankton
               iret = new_nc_variable(ncid,'wd1',NF_REAL,4,dims,wd1_id)
               iret = set_attributes(ncid,wd1_id,units='m/day', &
                                  long_name='Dead Phytoplankton settling velocity')
            ! Dead zooplankton
               iret = new_nc_variable(ncid,'wd2',NF_REAL,4,dims,wd2_id)
               iret = set_attributes(ncid,wd2_id,units='m/day', &
                                  long_name='Dead Zooplankton settling velocity')
            ! Fecals pellets
               iret = new_nc_variable(ncid,'wd3',NF_REAL,4,dims,wd3_id)
               iret = set_attributes(ncid,wd3_id,units='m/day', &
                                  long_name='Fecal pellets settling velocity')
            ! Marine Snow
               iret = new_nc_variable(ncid,'wd4',NF_REAL,4,dims,wd4_id)
               iret = set_attributes(ncid,wd4_id,units='m/day', &
e48ad91f   Gwenaelle Gremion   Clarification de ...
136
                                  long_name='Marine snow settling velocity (Calc)')
b15ffe85   Gwenaelle Gremion   Depot initial du ...
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

       ! Stickiness
            ! 2 Living phytoplankton
               iret = new_nc_variable(ncid,'sti_2p',NF_REAL,4,dims,sti_2p_id)
               iret = set_attributes(ncid,sti_2p_id, &
                                 long_name='Stickiness Phy & Phy')
            ! Living Phytoplankton with dead phytoplankton
               iret = new_nc_variable(ncid,'sti_pdph',NF_REAL,4,dims,sti_pdph_id)
               iret = set_attributes(ncid,sti_pdph_id, &
                                 long_name='Stickiness Phy & Dph')
            ! Living Phytoplankton with dead zooplankton
               iret = new_nc_variable(ncid,'sti_pdzo',NF_REAL,4,dims,sti_pdzo_id)
               iret = set_attributes(ncid,sti_pdzo_id, &
                                 long_name='Stickiness Phy & Dzo')
            ! Living Phytoplankton with fecal pellets
               iret = new_nc_variable(ncid,'sti_pfp',NF_REAL,4,dims,sti_pfp_id)
               iret = set_attributes(ncid,sti_pfp_id, &
                                 long_name='Stickiness Phy & Fp')
            ! 2 Dead phytoplankton
               iret = new_nc_variable(ncid,'sti_2dph',NF_REAL,4,dims,sti_2dph_id)
               iret = set_attributes(ncid,sti_2dph_id, &
                                 long_name='Stickiness Dph & Dph')
            ! Dead Phytoplankton with dead zooplankton
               iret = new_nc_variable(ncid,'sti_dphdzo',NF_REAL,4,dims,sti_dphdzo_id)
               iret = set_attributes(ncid,sti_dphdzo_id, &
                                 long_name='Stickiness Dph & Dzo')
            ! Dead  Phytoplankton with fecal pellets
               iret = new_nc_variable(ncid,'sti_dphfp',NF_REAL,4,dims,sti_dphfp_id)
               iret = set_attributes(ncid,sti_dphfp_id, &
                                 long_name='Stickiness Dph & Fp')
            ! 2 Dead zooplankton
               iret = new_nc_variable(ncid,'sti_2dzo',NF_REAL,4,dims,sti_2dzo_id)
               iret = set_attributes(ncid,sti_2dzo_id, &
                                 long_name='Stickiness Dzo & Dzo')
            ! Dead  zooplankton with fecal pellets
               iret = new_nc_variable(ncid,'sti_dzofp',NF_REAL,4,dims,sti_dzofp_id)
               iret = set_attributes(ncid,sti_dzofp_id, &
                                 long_name='Stickiness Dzo & Fp')
            ! 2 fecal pellets
               iret = new_nc_variable(ncid,'sti_2fp',NF_REAL,4,dims,sti_2fp_id)
               iret = set_attributes(ncid,sti_2fp_id, &
                                 long_name='Stickiness Fp & Fp')

              end if

b15ffe85   Gwenaelle Gremion   Depot initial du ...
182
!CHG4 Diagnostic du PAR
33b83817   dumoda01   Depot du modele /...
183
184
185
            iret = new_nc_variable(ncid,'par',NF_REAL,4,dims,par_id)
            iret = set_attributes(ncid,par_id,units='W/m2',long_name='PAR')

b15ffe85   Gwenaelle Gremion   Depot initial du ...
186
!DD Diagnostic des fonctions de croissance
4e171ca6   dumoda01   Modification du m...
187
188
189
190
191
192
193
194
195
196
197
198
199
200
            iret = new_nc_variable(ncid,'lumlim1',NF_REAL,4,dims,lumlim1_id)
            iret = set_attributes(ncid,lumlim1_id,units='1/day', &
                                  long_name='light limited growth rate for picophyto')
            iret = new_nc_variable(ncid,'nitlim1',NF_REAL,4,dims,nitlim1_id)
            iret = set_attributes(ncid,nitlim1_id,units='',long_name='nitrate limitation for picophyto')
            iret = new_nc_variable(ncid,'ammlim1',NF_REAL,4,dims,ammlim1_id)
            iret = set_attributes(ncid,ammlim1_id,units='',long_name='ammonium limitation for picophyto')
            iret = new_nc_variable(ncid,'lumlim2',NF_REAL,4,dims,lumlim2_id)
            iret = set_attributes(ncid,lumlim2_id,units='1/day', &
                                  long_name='light limited growth rate for microphyto')
            iret = new_nc_variable(ncid,'nitlim2',NF_REAL,4,dims,nitlim2_id)
            iret = set_attributes(ncid,nitlim2_id,units='',long_name='nitrate limitation for microphyto')
            iret = new_nc_variable(ncid,'ammlim2',NF_REAL,4,dims,ammlim2_id)
            iret = set_attributes(ncid,ammlim2_id,units='',long_name='ammonium limitation for microphyto')
bb33cab1   Dany Dumont   Ajout de la varia...
201
202
            iret = new_nc_variable(ncid,'ppnet',NF_REAL,4,dims,ppnet_id)
            iret = set_attributes(ncid,ppnet_id,units='1/day',long_name='net primary production rate')
4e171ca6   dumoda01   Modification du m...
203

e48ad91f   Gwenaelle Gremion   Clarification de ...
204
205
206
 !Polynow model
            if (bio_model .eq. 10) then
       ! Total flux of particle reaching msn
b15ffe85   Gwenaelle Gremion   Depot initial du ...
207
208
            iret = new_nc_variable(ncid,'flux_msn',NF_REAL,4,dims,flux_msn_id)
            iret = set_attributes(ncid,flux_msn_id,units='1/day',long_name='flux_msn')
e48ad91f   Gwenaelle Gremion   Clarification de ...
209
       ! Flux of Phyto going to msn
b15ffe85   Gwenaelle Gremion   Depot initial du ...
210
211
            iret = new_nc_variable(ncid,'Flux_P',NF_REAL,4,dims,Flux_P_id)
            iret = set_attributes(ncid,Flux_P_id,units='1/day',long_name='Flux_P')
e48ad91f   Gwenaelle Gremion   Clarification de ...
212
       ! Flux of DPH going to msn
b15ffe85   Gwenaelle Gremion   Depot initial du ...
213
214
            iret = new_nc_variable(ncid,'Flux_D1',NF_REAL,4,dims,Flux_D1_id)
            iret = set_attributes(ncid,Flux_D1_id,units='1/day',long_name='Flux_D1')
e48ad91f   Gwenaelle Gremion   Clarification de ...
215
216
       ! Flux of DZO going to msn
            iret = new_nc_variable(ncid,'Flux_D2',NF_REAL,4,dims,Flux_D2_id)
b15ffe85   Gwenaelle Gremion   Depot initial du ...
217
            iret = set_attributes(ncid,Flux_D2_id,units='1/day',long_name='Flux_D2')
e48ad91f   Gwenaelle Gremion   Clarification de ...
218
219
       ! Flux of FP going to msn
            iret = new_nc_variable(ncid,'Flux_D3',NF_REAL,4,dims,Flux_D3_id)
b15ffe85   Gwenaelle Gremion   Depot initial du ...
220
            iret = set_attributes(ncid,Flux_D3_id,units='1/day',long_name='Flux_D3')
e48ad91f   Gwenaelle Gremion   Clarification de ...
221
            endif
b15ffe85   Gwenaelle Gremion   Depot initial du ...
222
223

 !DD Diagnostic de npar (nb de particules lagrangiennes) pour bebogage
4e171ca6   dumoda01   Modification du m...
224
225
226
            !iret = new_nc_variable(ncid,'npar',NF_REAL,4,dims,npar_id)
            !iret = set_attributes(ncid,npar_id,units='', &
            !                      long_name='nb of particles per level')
a62e5d30   dumoda01   Complement de la ...
227

33b83817   dumoda01   Depot du modele /...
228
229
230
231
232
233
234
235
            dims(1) = time_dim
            iret = new_nc_variable(ncid,'totn',NF_REAL,1,dims,totn_id)
            iret = set_attributes(ncid,totn_id,units='mmol/m**2',    &
                   long_name='total N')

            iret = define_mode(ncid,.false.)
         end if

b15ffe85   Gwenaelle Gremion   Depot initial du ...
236
237
238
!-----------------------------------------------------------------------------------
!Prepare to store the data in the NetCDF file
!-----------------------------------------------------------------------------------
33b83817   dumoda01   Depot du modele /...
239
240
241
242
         do n=1,numc
            iret = store_data(ncid,var_ids(n),XYZT_SHAPE,nlev,array=cc(n,:))
         end do

b15ffe85   Gwenaelle Gremion   Depot initial du ...
243

e48ad91f   Gwenaelle Gremion   Clarification de ...
244
245
         !Density of the fluid at each level
         iret = store_data(ncid,rho_id,XYZT_SHAPE,nlev,array=rho)
b15ffe85   Gwenaelle Gremion   Depot initial du ...
246
247


8465f2a2   Dany Dumont   migration vertica...
248
         ! Sedimentation rate of phytoplankton
e48ad91f   Gwenaelle Gremion   Clarification de ...
249
         iret = store_data(ncid,wp_id,XYZT_SHAPE,nlev,array=secs_pr_day*ws(1,:))
b15ffe85   Gwenaelle Gremion   Depot initial du ...
250

8465f2a2   Dany Dumont   migration vertica...
251
         ! Swimming velocity of zootoplankton
b15ffe85   Gwenaelle Gremion   Depot initial du ...
252
!Nocera model
8465f2a2   Dany Dumont   migration vertica...
253
254
255
         if (bio_model .eq. 8) then
            iret = store_data(ncid,wz_id,XYZT_SHAPE,nlev,array=secs_pr_day*ws(2,:))
         end if
33b83817   dumoda01   Depot du modele /...
256

b15ffe85   Gwenaelle Gremion   Depot initial du ...
257
258
259
260
!Polynow model - [Values fond un ws(x,:) --> x represent the variables attribution made in bio_polynow.
!As example : :  p=1,z=2,b=3,d1(dph)=4,n=5,a=6,l=7,d2(dzo)=8,d3(fp)=9,d4(msn)=10
  
 if (bio_model .eq. 10) then
e48ad91f   Gwenaelle Gremion   Clarification de ...
261
262

! Here it is needed to multiply by 86400(secs_pr_day) in order to have the model ouptu (in s) convert in per day
b15ffe85   Gwenaelle Gremion   Depot initial du ...
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
            ! Living zooplankton
            iret = store_data(ncid,wz_id,XYZT_SHAPE,nlev,array=secs_pr_day*ws(2,:))
            ! Dead Phytoplankton
            iret = store_data(ncid,wd1_id,XYZT_SHAPE,nlev,array=secs_pr_day*ws(4,:))
            ! Dead zooplankton
            iret = store_data(ncid,wd2_id,XYZT_SHAPE,nlev,array=secs_pr_day*ws(8,:))
            ! Fecal pellets
            iret = store_data(ncid,wd3_id,XYZT_SHAPE,nlev,array=secs_pr_day*ws(9,:))
            ! Marine Snow
            iret = store_data(ncid,wd4_id,XYZT_SHAPE,nlev,array=secs_pr_day*ws(10,:))

       ! Stickiness
            ! 2 Living phytoplankton
             iret = store_data(ncid,sti_2p_id,XYZT_SHAPE,nlev,array=sti_2p(:))

            ! Living Phytoplankton with dead phytoplankton
             iret = store_data(ncid,sti_pdph_id,XYZT_SHAPE,nlev,array=sti_pdph(:))

            ! Living Phytoplankton with dead zooplankton
              iret = store_data(ncid,sti_pdzo_id,XYZT_SHAPE,nlev,array=sti_pdzo(:))

            ! Living Phytoplankton with fecal pellets
              iret = store_data(ncid,sti_pfp_id,XYZT_SHAPE,nlev,array=sti_pfp(:))

            ! 2 Dead phytoplankton
              iret = store_data(ncid,sti_2dph_id,XYZT_SHAPE,nlev,array=sti_2dph(:))

            ! Dead Phytoplankton with dead zooplankton
              iret = store_data(ncid,sti_dphdzo_id,XYZT_SHAPE,nlev,array=sti_dphdzo(:))

            ! Dead  Phytoplankton with fecal pellets
              iret = store_data(ncid,sti_dphfp_id,XYZT_SHAPE,nlev,array=sti_dphfp(:))

            ! 2 Dead zooplankton
              iret = store_data(ncid,sti_2dzo_id,XYZT_SHAPE,nlev,array=sti_2dzo(:))

            ! Dead  zooplankton with fecal pellets
              iret = store_data(ncid,sti_dzofp_id,XYZT_SHAPE,nlev,array=sti_dzofp(:))

            ! 2 fecal pellets
             iret = store_data(ncid,sti_2fp_id,XYZT_SHAPE,nlev,array=sti_2fp(:))

b15ffe85   Gwenaelle Gremion   Depot initial du ...
305
306
307
308
309
         ! Rho_F
    !     iret = store_data(ncid,rho_F_id,XYZT_SHAPE,nlev,array=)

  end if

8465f2a2   Dany Dumont   migration vertica...
310
         ! PAR
33b83817   dumoda01   Depot du modele /...
311
312
         iret = store_data(ncid,par_id,XYZT_SHAPE,nlev,array=par(:))

a62e5d30   dumoda01   Complement de la ...
313
         !DD
4e171ca6   dumoda01   Modification du m...
314
315
316
317
318
319
         iret = store_data(ncid,lumlim1_id,XYZT_SHAPE,nlev,array=lumlim1(:))
         iret = store_data(ncid,nitlim1_id,XYZT_SHAPE,nlev,array=nitlim1(:))
         iret = store_data(ncid,ammlim1_id,XYZT_SHAPE,nlev,array=ammlim1(:))
         iret = store_data(ncid,lumlim2_id,XYZT_SHAPE,nlev,array=lumlim2(:))
         iret = store_data(ncid,nitlim2_id,XYZT_SHAPE,nlev,array=nitlim2(:))
         iret = store_data(ncid,ammlim2_id,XYZT_SHAPE,nlev,array=ammlim2(:))
bb33cab1   Dany Dumont   Ajout de la varia...
320
         iret = store_data(ncid,ppnet_id,XYZT_SHAPE,nlev,array=ppnet(:))
4e171ca6   dumoda01   Modification du m...
321

e48ad91f   Gwenaelle Gremion   Clarification de ...
322
323
324
325
326
327
328
 if (bio_model .eq. 10) then
         iret = store_data(ncid,flux_msn_id,XYZT_SHAPE,nlev,array=secs_pr_day*flux_msn(:))
         iret = store_data(ncid,Flux_P_id,XYZT_SHAPE,nlev,array=secs_pr_day*Flux_P(:))
         iret = store_data(ncid,Flux_D1_id,XYZT_SHAPE,nlev,array=secs_pr_day*Flux_D1(:))
         iret = store_data(ncid,Flux_D2_id,XYZT_SHAPE,nlev,array=secs_pr_day*Flux_D2(:))
         iret = store_data(ncid,Flux_D3_id,XYZT_SHAPE,nlev,array=secs_pr_day*Flux_D3(:))
endif
b15ffe85   Gwenaelle Gremion   Depot initial du ...
329
330


4e171ca6   dumoda01   Modification du m...
331
332
         !DD
         !iret = store_data(ncid,npar_id,XYZT_SHAPE,nlev,array=npar(:))
a62e5d30   dumoda01   Complement de la ...
333

33b83817   dumoda01   Depot du modele /...
334
335
336
337
338
339
340
341
342
343
344
345
346
347
         iret = store_data(ncid,totn_id,T_SHAPE,1,scalar=totn)
#endif
      case default
         FATAL 'A non valid output format has been chosen'
         stop 'bio_save'
   end select

   return
   end subroutine bio_save
!EOC

!-----------------------------------------------------------------------
! Copyright by the GOTM-team under the GNU Public License - www.gnu.org
!-----------------------------------------------------------------------