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 branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/PISCES/SED – NEMO

source: branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90 @ 5712

Last change on this file since 5712 was 3443, checked in by cetlod, 12 years ago

branch:2012/dev_r3438_LOCEAN15_PISLOB : 1st step of the merge, see ticket #972

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