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.
trcrst_pisces.F90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/TOP_SRC/PISCES – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90 @ 2431

Last change on this file since 2431 was 2431, checked in by cetlod, 13 years ago

Improve the Offline together with the 1D vertical configuration
  • Property svn:keywords set to Id
File size: 13.1 KB
Line 
1MODULE trcrst_pisces
2   !!======================================================================
3   !!                       ***  MODULE trcrst_pisces  ***
4   !! TOP :   create, write, read the restart files of PISCES tracer
5   !!======================================================================
6   !! History :   1.0  !  2010-01 (C. Ethe) Original
7   !!----------------------------------------------------------------------
8#if defined key_pisces
9   !!----------------------------------------------------------------------
10   !!   'key_pisces'                                               pisces tracers
11   !!----------------------------------------------------------------------
12   !!   trc_rst_read_pisces   : read  restart file
13   !!   trc_rst_wri_pisces    : write restart file
14   !!----------------------------------------------------------------------
15   USE oce_trc         ! Ocean variables
16   USE par_trc         ! TOP parameters
17   USE trc             ! TOP variables
18   USE trcsms_pisces          ! pisces sms trends
19   USE sms_pisces          ! pisces sms variables
20   USE in_out_manager  ! I/O manager
21   USE iom
22   USE trcdta
23   USE lib_mpp
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC  trc_rst_read_pisces   ! called by trcini.F90 module
29   PUBLIC  trc_rst_wri_pisces   ! called by trcini.F90 module
30
31CONTAINS
32   
33   SUBROUTINE trc_rst_read_pisces( knum ) 
34      !!----------------------------------------------------------------------
35      !!                     ***  trc_rst_read_pisces  *** 
36      !!
37      !! ** Purpose : Read in restart file specific variables from pisces model
38      !!
39      !!----------------------------------------------------------------------
40      INTEGER, INTENT(in)  :: knum  ! unit of the restart file
41      INTEGER  ::  ji, jj, jk
42      REAL(wp) ::  zcaralk, zbicarb, zco3
43      REAL(wp) ::  ztmas, ztmas1
44      !!----------------------------------------------------------------------
45
46      !
47      IF( lk_dtatrc .AND. ln_pisclo ) CALL pis_dmp_clo  ! restoring of nutrients on close seas
48      IF( ln_pisdmp )                 CALL pis_dmp_ini  ! relaxation of some tracers
49      !
50      IF(lwp) WRITE(numout,*)
51      IF(lwp) WRITE(numout,*) ' trc_rst_read_pisces : Read specific variables from pisces model '
52      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
53      !
54      IF( iom_varid( knum, 'PH', ldstop = .FALSE. ) > 0 ) THEN
55         CALL iom_get( knum, jpdom_autoglo, 'PH' , hi(:,:,:)  )
56      ELSE
57         ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???)
58         ! --------------------------------------------------------
59         DO jk = 1, jpk
60            DO jj = 1, jpj
61               DO ji = 1, jpi
62                  ztmas   = tmask(ji,jj,jk)
63                  ztmas1  = 1. - tmask(ji,jj,jk)
64                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
65                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
66                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
67                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
68               END DO
69            END DO
70         END DO
71      ENDIF
72      CALL iom_get( knum, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 
73      IF( iom_varid( knum, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
74         CALL iom_get( knum, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  )
75      ELSE
76         xksimax(:,:) = xksi(:,:)
77      ENDIF
78
79   END SUBROUTINE trc_rst_read_pisces
80
81   SUBROUTINE trc_rst_wri_pisces( kt, kitrst, knum )
82      !!----------------------------------------------------------------------
83      !!                     ***  trc_rst_read_pisces  ***
84      !!
85      !! ** Purpose : Read in restart file specific variables from pisces model
86      !!
87      !!----------------------------------------------------------------------
88      INTEGER, INTENT(in)  :: kt      ! time step
89      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
90      INTEGER, INTENT(in)  :: knum    ! unit of the restart file
91      !!----------------------------------------------------------------------
92
93      IF(lwp) WRITE(numout,*)
94      IF(lwp) WRITE(numout,*) ' trc_rst_wri_pisces : Write specific variables from pisces model '
95      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
96
97      CALL iom_rstput( kt, kitrst, knum, 'PH', hi(:,:,:) )
98      CALL iom_rstput( kt, kitrst, knum, 'Silicalim', xksi(:,:) ) 
99      CALL iom_rstput( kt, kitrst, knum, 'Silicamax', xksimax(:,:) )
100
101   END SUBROUTINE trc_rst_wri_pisces
102
103   SUBROUTINE pis_dmp_ini
104      !!----------------------------------------------------------------------
105      !!                    ***  pis_dmp_ini  ***
106      !!
107      !! ** purpose  : Relaxation of some tracers
108      !!----------------------------------------------------------------------
109      INTEGER  :: ji, jj, jk
110      REAL(wp) ::  &
111         alkmean = 2426. ,  & ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
112         po4mean = 2.165 ,  & ! mean value of phosphates
113         no3mean = 30.90 ,  & ! mean value of nitrate
114         silmean = 91.51      ! mean value of silicate
115
116      REAL(wp) :: zarea, zvol, zalksum, zpo4sum, zno3sum, zsilsum
117
118
119      IF(lwp)  WRITE(numout,*)
120
121      IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) !
122         !                                                    ! --------------------------- !
123         ! set total alkalinity, phosphate, nitrate & silicate
124
125         zalksum = 0.e0
126         zpo4sum = 0.e0
127         zno3sum = 0.e0
128         zsilsum = 0.e0
129         DO jk = 1, jpk
130            DO jj = 1, jpj
131               DO ji = 1, jpi
132                  zvol = cvol(ji,jj,jk)
133#  if defined key_degrad
134                  zvol = zvol * facvol(ji,jj,jk)
135#  endif
136                  zalksum = zalksum + trn(ji,jj,jk,jptal) * zvol
137                  zpo4sum = zpo4sum + trn(ji,jj,jk,jppo4) * zvol
138                  zno3sum = zno3sum + trn(ji,jj,jk,jpno3) * zvol
139                  zsilsum = zsilsum + trn(ji,jj,jk,jpsil) * zvol
140               END DO
141            END DO
142         END DO
143         IF( lk_mpp )   CALL mpp_sum( zalksum )     ! sum over the global domain
144         IF( lk_mpp )   CALL mpp_sum( zpo4sum )     ! sum over the global domain
145         IF( lk_mpp )   CALL mpp_sum( zno3sum )     ! sum over the global domain
146         IF( lk_mpp )   CALL mpp_sum( zsilsum )     ! sum over the global domain
147         zarea   = 1. / areatot * 1.e6
148         zalksum = zalksum * zarea
149         zpo4sum = zpo4sum * zarea / 122.
150         zno3sum = zno3sum * zarea / 7.6
151         zsilsum = zsilsum * zarea
152
153         IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum
154         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum
155           
156         IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum
157         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum
158
159         IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum
160         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum
161
162         IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum
163         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum )
164         !
165      ENDIF
166
167!#if defined key_kriest
168!     !! Initialize number of particles from a standart restart file
169!     !! The name of big organic particles jpgoc has been only change
170!     !! and replace by jpnum but the values here are concentration
171!     trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)
172!     trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp )
173!#endif
174
175   END SUBROUTINE pis_dmp_ini
176
177   SUBROUTINE pis_dmp_clo   
178      !!---------------------------------------------------------------------
179      !!                  ***  ROUTINE pis_dmp_clo  ***
180      !!
181      !! ** Purpose :   Closed sea domain initialization
182      !!
183      !! ** Method  :   if a closed sea is located only in a model grid point
184      !!                we restore to initial data
185      !!
186      !! ** Action  :   ictsi1(), ictsj1() : south-west closed sea limits (i,j)
187      !!                ictsi2(), ictsj2() : north-east Closed sea limits (i,j)
188      !!----------------------------------------------------------------------
189      INTEGER, PARAMETER           ::   npicts   = 4       !: number of closed sea
190      INTEGER, DIMENSION(npicts)   ::   ictsi1, ictsj1     !: south-west closed sea limits (i,j)
191      INTEGER, DIMENSION(npicts)   ::   ictsi2, ictsj2     !: north-east closed sea limits (i,j)
192      INTEGER :: ji, jj, jk, jn, jc            ! dummy loop indices
193      !!----------------------------------------------------------------------
194
195      IF(lwp) WRITE(numout,*) 
196      IF(lwp) WRITE(numout,*)' pis_dmp_clo : closed seas '
197      IF(lwp) WRITE(numout,*)'~~~~~~~'
198
199      ! initial values
200      ictsi1(:) = 1  ;  ictsi2(:) = 1
201      ictsj1(:) = 1  ;  ictsj2(:) = 1
202
203      ! set the closed seas (in data domain indices)
204      ! -------------------
205
206      IF( cp_cfg == "orca" ) THEN
207         !
208         SELECT CASE ( jp_cfg )
209         !                                           ! =======================
210         CASE ( 2 )                                  !  ORCA_R2 configuration
211            !                                        ! =======================
212            !                                            ! Caspian Sea
213            ictsi1(1)   =  11  ;  ictsj1(1)   = 103
214            ictsi2(1)   =  17  ;  ictsj2(1)   = 112
215            !                                            ! Great North American Lakes
216            ictsi1(2)   =  97  ;  ictsj1(2)   = 107
217            ictsi2(2)   = 103  ;  ictsj2(2)   = 111
218            !                                            ! Black Sea 1 : west part of the Black Sea
219            ictsi1(3)   = 174  ; ictsj1(3)   = 107
220            ictsi2(3)   = 181  ; ictsj2(3)   = 112
221            !                                            ! Black Sea 2 : est part of the Black Sea
222            ictsi1(4)   =   2  ;  ictsj1(4)   = 107
223            ictsi2(4)   =   6  ;  ictsj2(4)   = 112
224            !                                        ! =======================
225         CASE ( 4 )                                  !  ORCA_R4 configuration
226            !                                        ! =======================
227            !                                            ! Caspian Sea
228            ictsi1(1)   =  4  ;  ictsj1(1)   = 53
229            ictsi2(1)   =  4  ;  ictsj2(1)   = 56
230            !                                            ! Great North American Lakes
231            ictsi1(2)   = 49  ;  ictsj1(2)   = 55
232            ictsi2(2)   = 51  ;  ictsj2(2)   = 56
233            !                                            ! Black Sea
234            ictsi1(3)   = 88  ;  ictsj1(3)   = 55
235            ictsi2(3)   = 91  ;  ictsj2(3)   = 56
236            !                                            ! Baltic Sea
237            ictsi1(4)   = 75  ;  ictsj1(4)   = 59
238            ictsi2(4)   = 76  ;  ictsj2(4)   = 61
239            !                                        ! =======================
240            !                                        ! =======================
241         CASE ( 025 )                                ! ORCA_R025 configuration
242            !                                        ! =======================
243                                                     ! Caspian + Aral sea
244            ictsi1(1)   = 1330 ; ictsj1(1)   = 645
245            ictsi2(1)   = 1400 ; ictsj2(1)   = 795
246            !                                        ! Azov Sea
247            ictsi1(2)   = 1284 ; ictsj1(2)   = 722
248            ictsi2(2)   = 1304 ; ictsj2(2)   = 747
249            !
250         END SELECT
251         !
252      ENDIF
253
254      ! convert the position in local domain indices
255      ! --------------------------------------------
256      DO jc = 1, npicts
257         ictsi1(jc)   = mi0( ictsi1(jc) )
258         ictsj1(jc)   = mj0( ictsj1(jc) )
259
260         ictsi2(jc)   = mi1( ictsi2(jc) )
261         ictsj2(jc)   = mj1( ictsj2(jc) )
262      END DO
263
264#if defined key_dtatrc
265      ! Restore close seas values to initial data
266      CALL trc_dta( nit000 ) 
267      DO jn = 1, jptra
268         IF( lutini(jn) ) THEN
269            DO jc = 1, npicts
270               DO jk = 1, jpkm1
271                  DO jj = ictsj1(jc), ictsj2(jc)
272                     DO ji = ictsi1(jc), ictsi2(jc)
273                        trn(ji,jj,jk,jn) = trdta(ji,jj,jk,jn) * tmask(ji,jj,jk) 
274                        trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
275                     ENDDO
276                  ENDDO
277               ENDDO
278            ENDDO
279         ENDIF
280      ENDDO
281#endif
282   !
283   END SUBROUTINE pis_dmp_clo
284
285#else
286   !!----------------------------------------------------------------------
287   !!  Dummy module :                                     No passive tracer
288   !!----------------------------------------------------------------------
289CONTAINS
290   SUBROUTINE trc_rst_read_pisces( knum )
291      INTEGER, INTENT(in)  :: knum
292      WRITE(*,*) 'trc_rst_read_pisces: You should not have seen this print! error?', knum
293   END SUBROUTINE trc_rst_read_pisces
294
295   SUBROUTINE trc_rst_wri_pisces( kt, kitrst, knum )
296     INTEGER, INTENT(in)  :: kt, kitrst, knum
297     WRITE(*,*) 'trc_rst_wri_pisces: You should not have seen this print! error?', kt, kitrst, knum
298   END SUBROUTINE trc_rst_wri_pisces
299#endif
300
301   !!======================================================================
302END MODULE trcrst_pisces
Note: See TracBrowser for help on using the repository browser.