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/2012/dev_r3452_UKMO9_RESTART/NEMOGCM/NEMO/TOP_SRC/SED – NEMO

source: branches/2012/dev_r3452_UKMO9_RESTART/NEMOGCM/NEMO/TOP_SRC/SED/sedrst.F90 @ 3594

Last change on this file since 3594 was 3594, checked in by rfurner, 11 years ago

code not tested through SETTEE, builds and runs, but has not been thoroughly tested, so will not be included in 2012 merge, however submitted back to keep record of work done for 2013 developments
  • Property svn:keywords set to Id
File size: 9.9 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      !! 0. initialisations
171      !! ------------------
172         
173      IF(lwp) WRITE(numsed,*) ' '
174      IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   &
175         'at it= ',kt
176      IF(lwp) WRITE(numsed,*) '~~~~~~~~~'
177     
178      !! 1. WRITE in nutwrs
179      !! ------------------
180
181      ic = 1
182      DO jc = 1,16
183         IF( cexper(jc:jc) /= ' ') ic = jc
184      END DO
185      WRITE( cln,'("_",i5.5,i2.2,i2.2,"_restart.sed")') nyear, nmonth, nday
186      clname = cexper(1:ic)//cln
187      itime = 0
188      CALL ymds2ju( nyear, nmonth, nday, rdt, zdate0 )
189      zdate0 = zdate0 - adatrj   !   set calendar origin to the beginning of the experiment
190      CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpksed, dz, &
191         &         clname, itime, zdate0, dtsed*nitrst, numrsw, domain_id=nidom )
192      zinfo(1) = REAL( kt)
193      CALL restput( numrsw, 'kt', 1,1, 1,0, zinfo  )
194
195
196
197      ! Back to 2D geometry
198      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), &
199         &                    solcp(1:jpoce,1:jpksed,jsopal ) )
200     
201      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), &
202         &                    solcp(1:jpoce,1:jpksed,jsclay ) )
203     
204      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), &
205         &                    solcp(1:jpoce,1:jpksed,jspoc  ) )
206       
207      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), &
208         &                    solcp(1:jpoce,1:jpksed,jscal  ) )   
209       
210      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), &
211         &                    pwcp(1:jpoce,1:jpksed,jwsil  )  )
212       
213      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6)  , iarroce(1:jpoce), &
214         &                    pwcp(1:jpoce,1:jpksed,jwoxy  ) )
215         
216      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7)  , iarroce(1:jpoce), &
217         &                    pwcp(1:jpoce,1:jpksed,jwdic  ) )
218         
219      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8)  , iarroce(1:jpoce), &
220         &                    pwcp(1:jpoce,1:jpksed,jwno3  ) )
221         
222      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9)  , iarroce(1:jpoce), &
223         &                    pwcp(1:jpoce,1:jpksed,jwpo4  ) )
224         
225      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10)  , iarroce(1:jpoce), &
226         &                    pwcp(1:jpoce,1:jpksed,jwalk  ) )
227       
228      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11)  , iarroce(1:jpoce), &
229         &                    pwcp(1:jpoce,1:jpksed,jwc13  ) )
230         
231      ! porosity
232      zdta(:,:) = 0.
233      DO jk = 1, jpksed
234         DO ji = 1, jpoce
235            zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) )
236         ENDDO
237      ENDDO
238      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
239         &                   zdta(1:jpoce,1:jpksed)  )
240     
241      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
242         &                   co3por(1:jpoce,1:jpksed)  )
243     
244      ! prognostic variables
245      ! --------------------
246
247      DO jn = 1, jptrased
248         cltra = sedtrcd(jn)
249         CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, trcsedi(:,:,:,jn) )
250      ENDDO
251
252      DO jn = 1, 2
253         cltra = seddia3d(jn)
254         CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, flxsedi3d(:,:,:,jn) )
255      ENDDO
256
257      CALL restclo( numrsw )
258
259      DEALLOCATE( zdta ) 
260         
261   END SUBROUTINE sed_rst_wri
262#else
263   !!======================================================================
264   !! MODULE sedrst :   Dummy module
265   !!======================================================================
266CONTAINS
267   SUBROUTINE sed_rst_read                      ! Empty routines
268   END SUBROUTINE sed_rst_read
269   SUBROUTINE sed_rst_wri( kt )
270      INTEGER, INTENT ( in ) :: kt
271      WRITE(*,*) 'sed_rst_wri: You should not have seen this print! error?', kt
272   END SUBROUTINE sed_rst_wri   
273#endif
274
275END MODULE sedrst
Note: See TracBrowser for help on using the repository browser.