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

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90 @ 3244

Last change on this file since 3244 was 3244, checked in by cetlod, 12 years ago

dev_NEMO_MERGE_2011 : Minor reorganisation of initialisation phase of TOP ; needed to get calendar information before the use of fldread
  • Property svn:keywords set to Id
File size: 10.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 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      !
47      IF(lwp) WRITE(numout,*)
48      IF(lwp) WRITE(numout,*) ' trc_rst_read_pisces : Read specific variables from pisces model '
49      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
50      !
51      IF( iom_varid( knum, 'PH', ldstop = .FALSE. ) > 0 ) THEN
52         CALL iom_get( knum, jpdom_autoglo, 'PH' , hi(:,:,:)  )
53      ELSE
54!         hi(:,:,:) = 1.e-9
55         ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???)
56         ! --------------------------------------------------------
57         DO jk = 1, jpk
58            DO jj = 1, jpj
59               DO ji = 1, jpi
60                  ztmas   = tmask(ji,jj,jk)
61                  ztmas1  = 1. - tmask(ji,jj,jk)
62                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
63                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
64                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
65                 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
66               END DO
67            END DO
68         END DO
69      ENDIF
70      CALL iom_get( knum, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 
71      IF( iom_varid( knum, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
72         CALL iom_get( knum, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  )
73      ELSE
74         xksimax(:,:) = xksi(:,:)
75      ENDIF
76
77   END SUBROUTINE trc_rst_read_pisces
78
79   SUBROUTINE trc_rst_wri_pisces( kt, kitrst, knum )
80      !!----------------------------------------------------------------------
81      !!                     ***  trc_rst_read_pisces  ***
82      !!
83      !! ** Purpose : Read in restart file specific variables from pisces model
84      !!
85      !!----------------------------------------------------------------------
86      INTEGER, INTENT(in)  :: kt      ! time step
87      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
88      INTEGER, INTENT(in)  :: knum    ! unit of the restart file
89      !!----------------------------------------------------------------------
90
91      IF(lwp) WRITE(numout,*)
92      IF(lwp) WRITE(numout,*) ' trc_rst_wri_pisces : Write specific variables from pisces model '
93      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
94
95      CALL iom_rstput( kt, kitrst, knum, 'PH', hi(:,:,:) )
96      CALL iom_rstput( kt, kitrst, knum, 'Silicalim', xksi(:,:) ) 
97      CALL iom_rstput( kt, kitrst, knum, 'Silicamax', xksimax(:,:) )
98
99   END SUBROUTINE trc_rst_wri_pisces
100
101   SUBROUTINE pis_dmp_clo   
102      !!---------------------------------------------------------------------
103      !!                  ***  ROUTINE pis_dmp_clo  ***
104      !!
105      !! ** Purpose :   Closed sea domain initialization
106      !!
107      !! ** Method  :   if a closed sea is located only in a model grid point
108      !!                we restore to initial data
109      !!
110      !! ** Action  :   ictsi1(), ictsj1() : south-west closed sea limits (i,j)
111      !!                ictsi2(), ictsj2() : north-east Closed sea limits (i,j)
112      !!----------------------------------------------------------------------
113      INTEGER, PARAMETER           ::   npicts   = 4        ! number of closed sea
114      INTEGER, DIMENSION(npicts)   ::   ictsi1, ictsj1      ! south-west closed sea limits (i,j)
115      INTEGER, DIMENSION(npicts)   ::   ictsi2, ictsj2      ! north-east closed sea limits (i,j)
116      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indices
117      INTEGER :: ierr                                       ! local integer
118      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  ztrcdta ! 4D  workspace
119      !!----------------------------------------------------------------------
120
121      IF(lwp) WRITE(numout,*) 
122      IF(lwp) WRITE(numout,*)' pis_dmp_clo : closed seas '
123      IF(lwp) WRITE(numout,*)'~~~~~~~'
124
125      ! initial values
126      ictsi1(:) = 1  ;  ictsi2(:) = 1
127      ictsj1(:) = 1  ;  ictsj2(:) = 1
128
129      ! set the closed seas (in data domain indices)
130      ! -------------------
131
132      IF( cp_cfg == "orca" ) THEN
133         !
134         SELECT CASE ( jp_cfg )
135         !                                           ! =======================
136         CASE ( 2 )                                  !  ORCA_R2 configuration
137            !                                        ! =======================
138            !                                            ! Caspian Sea
139            ictsi1(1)   =  11  ;  ictsj1(1)   = 103
140            ictsi2(1)   =  17  ;  ictsj2(1)   = 112
141            !                                            ! Great North American Lakes
142            ictsi1(2)   =  97  ;  ictsj1(2)   = 107
143            ictsi2(2)   = 103  ;  ictsj2(2)   = 111
144            !                                            ! Black Sea 1 : west part of the Black Sea
145            ictsi1(3)   = 174  ; ictsj1(3)   = 107
146            ictsi2(3)   = 181  ; ictsj2(3)   = 112
147            !                                            ! Black Sea 2 : est part of the Black Sea
148            ictsi1(4)   =   2  ;  ictsj1(4)   = 107
149            ictsi2(4)   =   6  ;  ictsj2(4)   = 112
150            !                                        ! =======================
151         CASE ( 4 )                                  !  ORCA_R4 configuration
152            !                                        ! =======================
153            !                                            ! Caspian Sea
154            ictsi1(1)   =  4  ;  ictsj1(1)   = 53
155            ictsi2(1)   =  4  ;  ictsj2(1)   = 56
156            !                                            ! Great North American Lakes
157            ictsi1(2)   = 49  ;  ictsj1(2)   = 55
158            ictsi2(2)   = 51  ;  ictsj2(2)   = 56
159            !                                            ! Black Sea
160            ictsi1(3)   = 88  ;  ictsj1(3)   = 55
161            ictsi2(3)   = 91  ;  ictsj2(3)   = 56
162            !                                            ! Baltic Sea
163            ictsi1(4)   = 75  ;  ictsj1(4)   = 59
164            ictsi2(4)   = 76  ;  ictsj2(4)   = 61
165            !                                        ! =======================
166            !                                        ! =======================
167         CASE ( 025 )                                ! ORCA_R025 configuration
168            !                                        ! =======================
169                                                     ! Caspian + Aral sea
170            ictsi1(1)   = 1330 ; ictsj1(1)   = 645
171            ictsi2(1)   = 1400 ; ictsj2(1)   = 795
172            !                                        ! Azov Sea
173            ictsi1(2)   = 1284 ; ictsj1(2)   = 722
174            ictsi2(2)   = 1304 ; ictsj2(2)   = 747
175            !
176         END SELECT
177         !
178      ENDIF
179
180      ! convert the position in local domain indices
181      ! --------------------------------------------
182      DO jc = 1, npicts
183         ictsi1(jc)   = mi0( ictsi1(jc) )
184         ictsj1(jc)   = mj0( ictsj1(jc) )
185
186         ictsi2(jc)   = mi1( ictsi2(jc) )
187         ictsj2(jc)   = mj1( ictsj2(jc) )
188      END DO
189
190      ! Restore close seas values to initial data
191      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
192        ALLOCATE( ztrcdta(jpi,jpj,jpk,nb_trcdta), STAT=ierr )
193        IF( ierr > 0 ) THEN
194           CALL ctl_stop( 'trc_ini: unable to allocate ztrcdta array' )   ;   RETURN
195        ENDIF
196        !
197        CALL trc_dta( nittrc000, ztrcdta )   ! read tracer data at nittrc000
198        !
199        DO jn = 1, jptra
200           IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
201              jl = n_trc_index(jn)
202              DO jc = 1, npicts
203                 DO jk = 1, jpkm1
204                    DO jj = ictsj1(jc), ictsj2(jc)
205                       DO ji = ictsi1(jc), ictsi2(jc)
206                          trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk) 
207                          trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
208                       ENDDO
209                    ENDDO
210                 ENDDO
211              ENDDO
212           ENDIF
213        ENDDO
214        DEALLOCATE( ztrcdta )
215      ENDIF
216      !
217   END SUBROUTINE pis_dmp_clo
218
219#else
220   !!----------------------------------------------------------------------
221   !!  Dummy module :                                     No passive tracer
222   !!----------------------------------------------------------------------
223CONTAINS
224   SUBROUTINE trc_rst_read_pisces( knum )
225      INTEGER, INTENT(in)  :: knum
226      WRITE(*,*) 'trc_rst_read_pisces: You should not have seen this print! error?', knum
227   END SUBROUTINE trc_rst_read_pisces
228
229   SUBROUTINE trc_rst_wri_pisces( kt, kitrst, knum )
230     INTEGER, INTENT(in)  :: kt, kitrst, knum
231     WRITE(*,*) 'trc_rst_wri_pisces: You should not have seen this print! error?', kt, kitrst, knum
232   END SUBROUTINE trc_rst_wri_pisces
233#endif
234
235   !!======================================================================
236END MODULE trcrst_pisces
Note: See TracBrowser for help on using the repository browser.