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

source: branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90 @ 2819

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

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