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

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90 @ 2528

Last change on this file since 2528 was 2528, checked in by rblod, 13 years ago

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