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 tags/nemo_v3_2/nemo_v3_2/NEMO/TOP_SRC/SED – NEMO

source: tags/nemo_v3_2/nemo_v3_2/NEMO/TOP_SRC/SED/sedrst.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm
File size: 10.1 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      INTEGER             ::   jlibalt = jprstlib
59      LOGICAL             ::   llok
60      !--------------------------------------------------------------------
61 
62
63      WRITE(numsed,*) ' '     
64      WRITE(numsed,*) ' Initilization of Sediment components from restart'
65      WRITE(numsed,*) ' '
66
67      ALLOCATE( zhipor(jpoce,jpksed) ) 
68
69      IF ( jprstlib == jprstdimg ) THEN
70        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
71        ! if restart_sed.nc exists, then set jlibalt to jpnf90
72        INQUIRE( FILE = 'restart_sed.nc', EXIST = llok )
73        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
74      ENDIF
75
76      CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt )     
77      CALL iom_get( numrsr, 'kt'     , zkt      )   ! time-step
78 
79      DO jn = 1, jptrased
80         cltra = sedtrcd(jn)
81         CALL iom_get( numrsr, jpdom_unknown, cltra, zdta(:,:,:,jn), &
82            &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) )
83      ENDDO
84       
85
86      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsopal), &
87         &            zdta(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )
88
89      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsclay), &
90         &             zdta(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )
91
92      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jspoc), &
93         &             zdta(1:jpi,1:jpj,1:jpksed,3), iarroce(1:jpoce) )
94
95      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jscal), &
96         &             zdta(1:jpi,1:jpj,1:jpksed,4), iarroce(1:jpoce) )
97
98      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwsil), &
99         &             zdta(1:jpi,1:jpj,1:jpksed,5), iarroce(1:jpoce) )
100
101
102      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwoxy), &
103         &             zdta(1:jpi,1:jpj,1:jpksed,6), iarroce(1:jpoce) )
104
105
106      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwdic), &
107         &             zdta(1:jpi,1:jpj,1:jpksed,7), iarroce(1:jpoce) )
108
109      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwno3), &
110         &             zdta(1:jpi,1:jpj,1:jpksed,8), iarroce(1:jpoce) )
111
112      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwpo4), &
113         &             zdta(1:jpi,1:jpj,1:jpksed,9), iarroce(1:jpoce) )
114
115      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwalk), &
116         &             zdta(1:jpi,1:jpj,1:jpksed,10), iarroce(1:jpoce) )
117
118      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwc13), &
119         &             zdta(1:jpi,1:jpj,1:jpksed,11), iarroce(1:jpoce) )
120
121      DO jn = 1, 2
122         cltra = seddia3d(jn)
123         CALL iom_get( numrsr, jpdom_unknown, cltra, zdta1(:,:,:,jn), &
124            &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) )
125      ENDDO
126
127      zhipor(:,:) = 0.
128      CALL pack_arr( jpoce, zhipor(1:jpoce,1:jpksed), &
129         &             zdta1(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )
130
131      ! Initialization of [h+] in mol/kg
132      DO jk = 1, jpksed
133         DO ji = 1, jpoce
134            hipor (ji,jk) = 10.**( -1. * zhipor(ji,jk) )
135         ENDDO
136      ENDDO
137     
138      CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), &
139         &             zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )
140
141      ! Initialization of sediment composant only ie jk=2 to jk=jpksed
142      ! ( nothing in jk=1)
143      solcp(1:jpoce,1,:) = 0.
144      pwcp (1:jpoce,1,:) = 0.
145
146      DEALLOCATE( zhipor )
147     
148   END SUBROUTINE sed_rst_read
149
150   SUBROUTINE sed_rst_wri( kt )
151      !!----------------------------------------------------------------------
152      !!                   ***  ROUTINE sed_rst_wri  ***
153      !!
154      !! ** Purpose :  save field which are necessary for sediment restart
155      !!
156      !!   History :
157      !!        !  06-07  (C. Ethe)  original
158      !!----------------------------------------------------------------------
159      !!* Modules used
160      USE ioipsl
161      !! *Arguments
162      INTEGER, INTENT(in) ::   kt       ! number of iteration
163      !! * local declarations
164
165      CHARACTER (len=50) :: clname,cln
166
167      INTEGER ::  &
168         ic,jc,jn,      &
169         itime
170
171     REAL(wp) ::  &
172         zdate0
173
174     REAL(wp), DIMENSION(1) :: &
175        zinfo
176
177      CHARACTER(len = 20)  ::  cltra 
178
179      INTEGER   :: ji, jk
180      REAL(wp), DIMENSION(:,:) , ALLOCATABLE  :: zdta   
181      !! -----------------------------------------------------------------------
182
183      ALLOCATE( zdta(jpoce,jpksed) )
184
185      IF( MOD(kt,nstock) == 0 .OR. kt == nitsedend ) THEN
186         
187         !! 0. initialisations
188         !! ------------------
189         
190         IF(lwp) WRITE(numsed,*) ' '
191         IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   &
192            'at it= ',kt
193         IF(lwp) WRITE(numsed,*) '~~~~~~~~~'
194         
195         !! 1. WRITE in nutwrs
196         !! ------------------
197
198         ic = 1
199         DO jc = 1,16
200            IF( cexper(jc:jc) /= ' ') ic = jc
201         END DO
202         WRITE( cln,'("_",i5.5,i2.2,i2.2,"_restart.sed")') nyear, nmonth, nday
203         clname = cexper(1:ic)//cln
204         itime = 0
205         CALL ymds2ju( nyear, nmonth, nday, rdt, zdate0 )
206         zdate0 = zdate0 - adatrj   !   set calendar origin to the beginning of the experiment
207         CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpksed, dz, &
208            &         clname, itime, zdate0, dtsed*nstock, numrsw, domain_id=nidom )
209         zinfo(1) = REAL( kt)
210         CALL restput( numrsw, 'kt', 1,1, 1,0, zinfo  )
211
212
213
214         ! Back to 2D geometry
215         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), &
216            &                    solcp(1:jpoce,1:jpksed,jsopal ) )
217         
218         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), &
219            &                    solcp(1:jpoce,1:jpksed,jsclay ) )
220         
221         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), &
222            &                    solcp(1:jpoce,1:jpksed,jspoc  ) )
223         
224         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), &
225            &                    solcp(1:jpoce,1:jpksed,jscal  ) )   
226         
227         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), &
228            &                    pwcp(1:jpoce,1:jpksed,jwsil  )  )
229         
230         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6)  , iarroce(1:jpoce), &
231            &                    pwcp(1:jpoce,1:jpksed,jwoxy  ) )
232         
233         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7)  , iarroce(1:jpoce), &
234            &                    pwcp(1:jpoce,1:jpksed,jwdic  ) )
235         
236         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8)  , iarroce(1:jpoce), &
237            &                    pwcp(1:jpoce,1:jpksed,jwno3  ) )
238         
239         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9)  , iarroce(1:jpoce), &
240            &                    pwcp(1:jpoce,1:jpksed,jwpo4  ) )
241         
242         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10)  , iarroce(1:jpoce), &
243            &                    pwcp(1:jpoce,1:jpksed,jwalk  ) )
244         
245         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11)  , iarroce(1:jpoce), &
246         &                    pwcp(1:jpoce,1:jpksed,jwc13  ) )
247         
248         ! porosity
249         zdta(:,:) = 0.
250         DO jk = 1, jpksed
251            DO ji = 1, jpoce
252               zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) )
253            ENDDO
254         ENDDO
255         CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
256            &                   zdta(1:jpoce,1:jpksed)  )
257         
258         CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
259            &                   co3por(1:jpoce,1:jpksed)  )
260     
261         ! prognostic variables
262         ! --------------------
263
264
265         DO jn = 1, jptrased
266            cltra = sedtrcd(jn)
267            CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, trcsedi(:,:,:,jn) )
268         ENDDO
269
270         DO jn = 1, 2
271            cltra = seddia3d(jn)
272            CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, flxsedi3d(:,:,:,jn) )
273         ENDDO
274
275
276         CALL restclo( numrsw )
277
278      ENDIF
279
280      DEALLOCATE( zdta ) 
281         
282   END SUBROUTINE sed_rst_wri
283#else
284   !!======================================================================
285   !! MODULE sedrst :   Dummy module
286   !!======================================================================
287CONTAINS
288   SUBROUTINE sed_rst_read                      ! Empty routines
289   END SUBROUTINE sed_rst_read
290   SUBROUTINE sed_rst_wri( kt )
291      INTEGER, INTENT ( in ) :: kt
292      WRITE(*,*) 'sed_rst_wri: You should not have seen this print! error?', kt
293   END SUBROUTINE sed_rst_wri   
294#endif
295
296END MODULE sedrst
Note: See TracBrowser for help on using the repository browser.