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/DEV_r1784_mid_year_merge_2010/NEMO/TOP_SRC/PISCES – NEMO

source: branches/DEV_r1784_mid_year_merge_2010/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90 @ 1953

Last change on this file since 1953 was 1953, checked in by acc, 14 years ago

ticket #684 step 3: Add in changes from the trunk between revisions 1784 and 1821. No conflicts so far

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