source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 5 years ago

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

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