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.
sedrst.F90 in trunk/NEMO/TOP_SRC/SED – NEMO

source: trunk/NEMO/TOP_SRC/SED/sedrst.F90 @ 1250

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

update modules of sediment model to take into account minor modifications, see ticket:297
File size: 9.6 KB
Line 
1MODULE sedrst
2#if defined key_sed
3   !!======================================================================
4   !!                       *** MODULE sedrst ***
5   !!   Read and write the restart files for sediment
6   !!======================================================================
7
8   !!----------------------------------------------------------------------
9   !! * Modules used
10   !! ==============
11   USE sed
12   USE sedarr
13
14
15   !! * Accessibility
16   IMPLICIT NONE
17   PRIVATE
18
19   !! * Accessibility
20   PUBLIC sed_rst_read
21   PUBLIC sed_rst_wri
22
23   !! * Module variables
24   INTEGER, PUBLIC ::   numrsr, numrsw   !: logical unit for sed restart (read and write)
25   
26   
27CONTAINS
28
29
30   SUBROUTINE sed_rst_read 
31      !!----------------------------------------------------------------------
32      !!                   ***  ROUTINE sed_rst_read  ***
33      !!
34      !! ** Purpose :  Initialization of sediment module
35      !!               - sets initial sediment composition
36      !!                 ( only clay or reading restart file )
37      !!
38      !!   History :
39      !!        !  06-07  (C. Ethe)  original
40      !!----------------------------------------------------------------------
41      !! * Modules used
42      USE iom
43
44      !! * local declarations
45      INTEGER :: &
46         ji, jk, jn
47      REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: &
48         zdta
49
50      REAL(wp), DIMENSION(jpi,jpj,jpksed,2) :: &
51         zdta1
52
53      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
54         zhipor
55
56      REAL(wp) :: zkt
57      CHARACTER(len = 20)  ::  cltra
58      !--------------------------------------------------------------------
59 
60
61      WRITE(numsed,*) ' '     
62      WRITE(numsed,*) ' Initilization of Sediment components from restart'
63      WRITE(numsed,*) ' '
64
65      ALLOCATE( zhipor(jpoce,jpksed) ) 
66
67      CALL iom_open( 'restart_sed', numrsr, kiolib = jprstlib )     
68      CALL iom_get( numrsr, 'kt'     , zkt      )   ! time-step
69 
70      DO jn = 1, jptrased
71         cltra = sedtrcd(jn)
72         CALL iom_get( numrsr, jpdom_unknown, cltra, zdta(:,:,:,jn), &
73            &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) )
74      ENDDO
75       
76
77      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsopal), &
78         &            zdta(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )
79
80      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsclay), &
81         &             zdta(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )
82
83      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jspoc), &
84         &             zdta(1:jpi,1:jpj,1:jpksed,3), iarroce(1:jpoce) )
85
86      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jscal), &
87         &             zdta(1:jpi,1:jpj,1:jpksed,4), iarroce(1:jpoce) )
88
89      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwsil), &
90         &             zdta(1:jpi,1:jpj,1:jpksed,5), iarroce(1:jpoce) )
91
92
93      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwoxy), &
94         &             zdta(1:jpi,1:jpj,1:jpksed,6), iarroce(1:jpoce) )
95
96
97      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwdic), &
98         &             zdta(1:jpi,1:jpj,1:jpksed,7), iarroce(1:jpoce) )
99
100      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwno3), &
101         &             zdta(1:jpi,1:jpj,1:jpksed,8), iarroce(1:jpoce) )
102
103      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwpo4), &
104         &             zdta(1:jpi,1:jpj,1:jpksed,9), iarroce(1:jpoce) )
105
106      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwalk), &
107         &             zdta(1:jpi,1:jpj,1:jpksed,10), iarroce(1:jpoce) )
108
109      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwc13), &
110         &             zdta(1:jpi,1:jpj,1:jpksed,11), iarroce(1:jpoce) )
111
112      DO jn = 1, 2
113         cltra = seddia3d(jn)
114         CALL iom_get( numrsr, jpdom_unknown, cltra, zdta1(:,:,:,jn), &
115            &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) )
116      ENDDO
117
118      zhipor(:,:) = 0.
119      CALL pack_arr( jpoce, zhipor(1:jpoce,1:jpksed), &
120         &             zdta1(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )
121
122      ! Initialization of [h+] in mol/kg
123      DO jk = 1, jpksed
124         DO ji = 1, jpoce
125            hipor (ji,jk) = 10.**( -1. * zhipor(ji,jk) )
126         ENDDO
127      ENDDO
128     
129      CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), &
130         &             zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )
131
132      ! Initialization of sediment composant only ie jk=2 to jk=jpksed
133      ! ( nothing in jk=1)
134      solcp(1:jpoce,1,:) = 0.
135      pwcp (1:jpoce,1,:) = 0.
136
137      DEALLOCATE( zhipor )
138     
139   END SUBROUTINE sed_rst_read
140
141   SUBROUTINE sed_rst_wri( kt )
142      !!----------------------------------------------------------------------
143      !!                   ***  ROUTINE sed_rst_wri  ***
144      !!
145      !! ** Purpose :  save field which are necessary for sediment restart
146      !!
147      !!   History :
148      !!        !  06-07  (C. Ethe)  original
149      !!----------------------------------------------------------------------
150      !!* Modules used
151      USE ioipsl
152      !! *Arguments
153      INTEGER, INTENT(in) ::   kt       ! number of iteration
154      !! * local declarations
155
156      CHARACTER (len=50) :: clname,cln
157
158      INTEGER ::  &
159         ic,jc,jn,      &
160         itime
161
162     REAL(wp) ::  &
163         zdate0
164
165     REAL(wp), DIMENSION(1) :: &
166        zinfo
167
168      CHARACTER(len = 20)  ::  cltra 
169
170      INTEGER   :: ji, jk
171      REAL(wp), DIMENSION(:,:) , ALLOCATABLE  :: zdta   
172      !! -----------------------------------------------------------------------
173
174      ALLOCATE( zdta(jpoce,jpksed) )
175
176      IF( MOD(kt,nstock) == 0 .OR. kt == nitsedend ) THEN
177         
178         !! 0. initialisations
179         !! ------------------
180         
181         IF(lwp) WRITE(numsed,*) ' '
182         IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   &
183            'at it= ',kt
184         IF(lwp) WRITE(numsed,*) '~~~~~~~~~'
185         
186         !! 1. WRITE in nutwrs
187         !! ------------------
188
189         ic = 1
190         DO jc = 1,16
191            IF( cexper(jc:jc) /= ' ') ic = jc
192         END DO
193         WRITE( cln,'("_",i5.5,i2.2,i2.2,"_restart.sed")') nyear, nmonth, nday
194         clname = cexper(1:ic)//cln
195         itime = 0
196         CALL ymds2ju( nyear, nmonth, nday, 0.0, zdate0 )
197         CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpksed, dz, &
198            &         clname, itime, zdate0, dtsed*nstock, numrsw, domain_id=nidom )
199         zinfo(1) = REAL( kt)
200         CALL restput( numrsw, 'kt', 1,1, 1,0, zinfo  )
201
202
203
204         ! Back to 2D geometry
205         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), &
206            &                    solcp(1:jpoce,1:jpksed,jsopal ) )
207         
208         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), &
209            &                    solcp(1:jpoce,1:jpksed,jsclay ) )
210         
211         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), &
212            &                    solcp(1:jpoce,1:jpksed,jspoc  ) )
213         
214         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), &
215            &                    solcp(1:jpoce,1:jpksed,jscal  ) )   
216         
217         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), &
218            &                    pwcp(1:jpoce,1:jpksed,jwsil  )  )
219         
220         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6)  , iarroce(1:jpoce), &
221            &                    pwcp(1:jpoce,1:jpksed,jwoxy  ) )
222         
223         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7)  , iarroce(1:jpoce), &
224            &                    pwcp(1:jpoce,1:jpksed,jwdic  ) )
225         
226         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8)  , iarroce(1:jpoce), &
227            &                    pwcp(1:jpoce,1:jpksed,jwno3  ) )
228         
229         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9)  , iarroce(1:jpoce), &
230            &                    pwcp(1:jpoce,1:jpksed,jwpo4  ) )
231         
232         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10)  , iarroce(1:jpoce), &
233            &                    pwcp(1:jpoce,1:jpksed,jwalk  ) )
234         
235         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11)  , iarroce(1:jpoce), &
236         &                    pwcp(1:jpoce,1:jpksed,jwc13  ) )
237         
238         ! porosity
239         zdta(:,:) = 0.
240         DO jk = 1, jpksed
241            DO ji = 1, jpoce
242               zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) )
243            ENDDO
244         ENDDO
245         CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
246            &                   zdta(1:jpoce,1:jpksed)  )
247         
248         CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
249            &                   co3por(1:jpoce,1:jpksed)  )
250     
251         ! prognostic variables
252         ! --------------------
253
254
255         DO jn = 1, jptrased
256            cltra = sedtrcd(jn)
257            CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, trcsedi(:,:,:,jn) )
258         ENDDO
259
260         DO jn = 1, 2
261            cltra = seddia3d(jn)
262            CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, flxsedi3d(:,:,:,jn) )
263         ENDDO
264
265
266         CALL restclo( numrsw )
267
268      ENDIF
269
270      DEALLOCATE( zdta ) 
271         
272   END SUBROUTINE sed_rst_wri
273#else
274   !!======================================================================
275   !! MODULE sedrst :   Dummy module
276   !!======================================================================
277CONTAINS
278   SUBROUTINE sed_rst_read                      ! Empty routines
279   END SUBROUTINE sed_rst_read
280   SUBROUTINE sed_rst_wri( kt )
281      INTEGER, INTENT ( in ) :: kt
282      WRITE(*,*) 'sed_rst_wri: You should not have seen this print! error?', kt
283   END SUBROUTINE sed_rst_wri   
284#endif
285
286END MODULE sedrst
Note: See TracBrowser for help on using the repository browser.