New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
seddta.F90 in trunk/NEMO/TOP_SRC/SED – NEMO

source: trunk/NEMO/TOP_SRC/SED/seddta.F90 @ 1264

Last change on this file since 1264 was 1264, checked in by cetlod, 15 years ago

clean TOP model routines to avoid warning when compiling, see ticket:303

File size: 11.6 KB
Line 
1MODULE seddta
2   !!======================================================================
3   !!                     ***  MODULE  seddta  ***
4   !! Sediment data  :  read sediment input data from a file
5   !!=====================================================================
6#if defined key_sed
7   !! * Modules used
8   USE sed
9   USE sedarr
10   USE iom
11
12   IMPLICIT NONE
13   PRIVATE
14
15   !! * Routine accessibility
16   PUBLIC sed_dta   !
17
18   !! *  Module variables
19   REAL(wp), DIMENSION(:), ALLOCATABLE :: &
20      smask       ! mask for sediments points
21
22   REAL(wp) ::  &
23      rsecday  , &  ! number of second per a day
24      conv1    , &  ! [m/day]--->[cm/s] 
25      conv2         ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days )
26
27   INTEGER ::     &
28     numbio 
29
30#if defined key_sed_off
31   INTEGER ::     &
32     numoce
33#endif
34
35CONTAINS
36
37   !!---------------------------------------------------------------------------
38   !!   sed_dta  : read the NetCDF data file in online version using module iom
39   !!---------------------------------------------------------------------------
40
41   SUBROUTINE sed_dta( kt )
42      !!----------------------------------------------------------------------
43      !!                   ***  ROUTINE sed_dta  ***
44      !!                   
45      !! ** Purpose :   Reads data from a netcdf file and
46      !!                initialization of rain and pore water (k=1) components
47      !!
48      !!
49      !!   History :
50      !!        !  04-10  (N. Emprin, M. Gehlen )  Original code
51      !!        !  06-04  (C. Ethe)  Re-organization ; Use of iom
52      !!----------------------------------------------------------------------
53
54      !! Arguments
55      INTEGER, INTENT(in) :: &
56         kt
57
58      !! * Local declarations
59      INTEGER  ::  ji, jj, js, jw, ikt
60
61      REAL(wp) , DIMENSION (jpi,jpj) :: zdta
62#if ! defined key_kriest
63      REAL(wp) , DIMENSION (:), ALLOCATABLE  :: zdtap , zdtag
64#endif 
65
66
67      !----------------------------------------------------------------------
68
69      ! Initialization of sediment variable
70      ! Spatial dimension is merged, and unity converted if needed
71      !-------------------------------------------------------------
72
73      WRITE(numsed,*)
74      WRITE(numsed,*) ' sed_dta : Bottom layer fields'
75      WRITE(numsed,*) ' ~~~~~~'
76      WRITE(numsed,*) ' Data from SMS model'
77      WRITE(numsed,*)
78
79
80      ! open file
81      IF( kt == nitsed000 ) THEN
82         WRITE(numsed,*) ' sed_dta : Sediment fields'
83         CALL iom_open ( 'data_bio_bot'     , numbio )
84#if defined key_sed_off
85         CALL iom_open( 'data_oce_bot', numoce)
86#endif
87         rsecday = 60.* 60. * 24.
88         conv1   = 1.0e+2 / rsecday 
89         conv2   = 1.0e+3 / ( 1.0e+4 * rsecday * 30. ) 
90
91         ! Compute sediment mask
92         DO jj = 1, jpj
93            DO ji = 1, jpi
94               ikt = MAX( INT( sbathy(ji,jj) ) - 1, 1 )
95               zdta(ji,jj) = tmask(ji,jj,ikt) 
96            ENDDO
97         ENDDO
98         ALLOCATE( smask(jpoce) )
99         smask(:) = 0.
100         CALL pack_arr( jpoce, smask(1:jpoce), zdta(1:jpi,1:jpj), iarroce(1:jpoce) )
101      ENDIF
102
103
104#if ! defined key_kriest   
105      ! Initialization of temporaries arrays 
106      ALLOCATE( zdtap   (jpoce) )    ;   zdtap(:)    = 0. 
107      ALLOCATE( zdtag   (jpoce) )    ;   zdtag(:)    = 0. 
108#endif
109
110
111      IF( MOD( kt - 1, nfreq ) == 0 ) THEN
112         ! reading variables
113         WRITE(numsed,*)
114         WRITE(numsed,*) ' sed_dta : Bottom layer fields at time  kt = ', kt
115         ! reading variables
116         trc_data(:,:,:) = 0.
117#if ! defined key_sed_off
118         DO jj = 1,jpj
119            DO ji = 1, jpi
120               ikt = MAX( mbathy(ji,jj)-1, 1 )
121               IF ( tmask(ji,jj,ikt) == 1 ) THEN
122                  trc_data(ji,jj,1)  = trn  (ji,jj,ikt,jptal)
123                  trc_data(ji,jj,2)  = trn  (ji,jj,ikt,jpdic)
124                  trc_data(ji,jj,3)  = trn  (ji,jj,ikt,jpno3) / 7.6
125                  trc_data(ji,jj,4)  = trn  (ji,jj,ikt,jppo4) / 122.
126                  trc_data(ji,jj,5)  = trn  (ji,jj,ikt,jpoxy)
127                  trc_data(ji,jj,6)  = trn  (ji,jj,ikt,jpsil)
128#   if ! defined key_kriest
129                  trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt)
130                  trc_data(ji,jj,8 ) = sinking (ji,jj,ikt)
131                  trc_data(ji,jj,9 ) = sinking2(ji,jj,ikt)
132                  trc_data(ji,jj,10) = sinkcal (ji,jj,ikt)
133                  trc_data(ji,jj,11) = tn      (ji,jj,ikt)
134                  trc_data(ji,jj,12) = sn      (ji,jj,ikt)
135#   else
136                  trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt)
137                  trc_data(ji,jj,8 ) = sinking (ji,jj,ikt)
138                  trc_data(ji,jj,9 ) = sinkcal (ji,jj,ikt)
139                  trc_data(ji,jj,10) = tn      (ji,jj,ikt)
140                  trc_data(ji,jj,11) = sn      (ji,jj,ikt)       
141#   endif
142               ENDIF
143            ENDDO
144         ENDDO
145
146#else
147         CALL iom_get( numbio, jpdom_data, 'ALKBOT'     , trc_data(:,:,1 ) )
148         CALL iom_get( numbio, jpdom_data, 'DICBOT'     , trc_data(:,:,2 ) )
149         CALL iom_get( numbio, jpdom_data, 'NO3BOT'     , trc_data(:,:,3 ) )
150         CALL iom_get( numbio, jpdom_data, 'PO4BOT'     , trc_data(:,:,4 ) )
151         CALL iom_get( numbio, jpdom_data, 'O2BOT'      , trc_data(:,:,5 ) )
152         CALL iom_get( numbio, jpdom_data, 'SIBOT'      , trc_data(:,:,6 ) )
153#   if ! defined key_kriest
154         CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) ) 
155         CALL iom_get( numbio, jpdom_data, 'POCFLXBOT'  , trc_data(:,:,8 ) ) 
156         CALL iom_get( numbio, jpdom_data, 'GOCFLXBOT'  , trc_data(:,:,9 ) ) 
157         CALL iom_get( numbio, jpdom_data, 'CACO3FLXBOT', trc_data(:,:,10) ) 
158         CALL iom_get( numoce, jpdom_data, 'TBOT'       , trc_data(:,:,11) ) 
159         CALL iom_get( numoce, jpdom_data, 'SBOT'       , trc_data(:,:,12) ) 
160#   else
161         CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) ) 
162         CALL iom_get( numbio, jpdom_data, 'POCFLXBOT'  , trc_data(:,:,8 ) ) 
163         CALL iom_get( numbio, jpdom_data, 'CACO3FLXBOT', trc_data(:,:,9 ) ) 
164         CALL iom_get( numoce, jpdom_data, 'TBOT'       , trc_data(:,:,10) ) 
165         CALL iom_get( numoce, jpdom_data, 'SBOT'       , trc_data(:,:,11) ) 
166#   endif
167#endif
168
169         ! Pore water initial concentration [mol/l] in  k=1
170         !-------------------------------------------------
171
172          ! Alkalinity ( 1 umol = 10-6equivalent )
173         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwalk), trc_data(1:jpi,1:jpj,1), iarroce(1:jpoce) )
174         ! DIC
175         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwdic), trc_data(1:jpi,1:jpj,2), iarroce(1:jpoce) )
176         ! Nitrates (1 umol/l = 10-6 mol/l)
177         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwno3), trc_data(1:jpi,1:jpj,3), iarroce(1:jpoce) )
178         ! Phosphates (1 umol/l = 10-6 mol/l)
179         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwpo4), trc_data(1:jpi,1:jpj,4), iarroce(1:jpoce) )
180         ! Oxygen (1 umol/l = 10-6 mol/l)
181         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwoxy), trc_data(1:jpi,1:jpj,5), iarroce(1:jpoce) )       
182         ! Silicic Acid [mol.l-1]
183         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwsil), trc_data(1:jpi,1:jpj,6), iarroce(1:jpoce) )                 
184         ! DIC13 (mol/l)obtained from dc13 and DIC (12) and PDB
185         CALL iom_get ( numbio,jpdom_data,'DC13',zdta(:,:) )
186         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwc13), zdta(1:jpi,1:jpj), iarroce(1:jpoce) )
187         pwcp_dta(1:jpoce,jwc13) = pdb * ( pwcp_dta(1:jpoce,jwc13) * 1.0e-3 + 1.0 )  &
188            &                          *   pwcp_dta(1:jpoce,jwdic)         
189         
190         !  Solid components :
191         !-----------------------
192#if ! defined key_kriest
193         !  Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
194         CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) ) 
195         rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4
196         !  Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
197         CALL pack_arr ( jpoce, zdtap(1:jpoce), trc_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) )     
198         CALL pack_arr ( jpoce, zdtag(1:jpoce), trc_data(1:jpi,1:jpj,9) , iarroce(1:jpoce) )
199         rainrm_dta(1:jpoce,jspoc) =   ( zdtap(1:jpoce) +  zdtag(1:jpoce) ) * 1e-4
200         !  Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
201         CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,10), iarroce(1:jpoce) )
202         rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4
203         ! vector temperature [°C] and salinity
204         CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) )
205         CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,12), iarroce(1:jpoce) )
206#else
207         !  Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
208         CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) ) 
209         rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4
210         !  Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
211         CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jspoc), trc_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) )     
212         rainrm_dta(1:jpoce,jspoc) = rainrm_dta(1:jpoce,jspoc) * 1e-4
213         !  Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
214         CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,9), iarroce(1:jpoce) )
215         rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4
216         ! vector temperature [°C] and salinity
217         CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,10), iarroce(1:jpoce) )
218         CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) )
219
220#endif
221       
222         ! Clay rain rate in [mol/(cm**2.s)]
223         ! inputs data in [kg.m-2.mois-1] ---> 1e+3/(1e+4*60*24*60*60) [g.cm-2.s-1]   
224         ! divided after by molecular weight g.mol-1     
225         zdta(:,:)   = 0.
226         CALL iom_get( numbio, jpdom_data, 'CLAY', zdta(:,:) ) 
227         CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsclay) , zdta(1:jpi,1:jpj), iarroce(1:jpoce) )     
228         rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * conv2 / mol_wgt(jsclay)
229
230      ENDIF
231
232      ! sediment pore water at 1st layer (k=1)
233      DO jw = 1, jpwat
234         pwcp(1:jpoce,1,jw) = pwcp_dta(1:jpoce,jw) * smask(1:jpoce)
235      ENDDO
236
237      !  rain
238      DO js = 1, jpsol
239         rainrm(1:jpoce,js) = rainrm_dta(1:jpoce,js) * smask(1:jpoce)
240      ENDDO
241
242      ! Calculation of raintg of each sol. comp.: rainrm in [g/(cm**2.s)]
243      DO js = 1, jpsol
244         rainrg(1:jpoce,js) = rainrm(1:jpoce,js) *  mol_wgt(js)
245      ENDDO
246
247      ! Calculation of raintg = total massic flux rained in each cell (sum of sol. comp.)
248      raintg(:) = 0.
249      DO js = 1, jpsol
250         raintg(1:jpoce) = raintg(1:jpoce) + rainrg(1:jpoce,js)
251      ENDDO
252
253      ! computation of dzdep = total thickness of solid material rained [cm] in each cell
254      dzdep(1:jpoce) = raintg(1:jpoce) * rdtsed(2) 
255
256
257#if ! defined key_kriest
258      DEALLOCATE( zdtap    ) ;  DEALLOCATE( zdtag    ) 
259#endif     
260
261      IF( kt == nitsedend )   THEN
262         CALL iom_close ( numbio )
263#if defined key_sed_off
264         CALL iom_close ( numoce )
265#endif
266      ENDIF
267     
268   END SUBROUTINE sed_dta
269
270#else
271   !!======================================================================
272   !! MODULE seddta  :   Dummy module
273   !!======================================================================
274CONTAINS
275   SUBROUTINE sed_dta ( kt )
276     INTEGER, INTENT(in) :: kt
277     WRITE(*,*) 'sed_stp: You should not have seen this print! error?', kt 
278  END SUBROUTINE sed_dta
279#endif
280
281END MODULE seddta
Note: See TracBrowser for help on using the repository browser.