- Timestamp:
- 2018-06-21T11:58:42+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r9816 r9817 8 8 !! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture 9 9 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 10 !! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_top … … 24 25 USE trcini_c14b ! C14 bomb initialisation 25 26 USE trcini_my_trc ! MY_TRC initialisation 27 USE trcini_medusa ! MEDUSA initialisation 28 USE trcini_idtra ! idealize tracer initialisation 29 USE trcini_age ! AGE initialisation 26 30 USE trcdta ! initialisation from files 27 31 USE daymod ! calendar manager 28 USE zpshde ! partial step: hor. derivative (zps_hde routine)29 32 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 30 33 USE trcsub ! variables to substep passive tracers … … 61 64 INTEGER :: jk, jn, jl ! dummy loop indices 62 65 CHARACTER (len=25) :: charout 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 4D workspace64 66 !!--------------------------------------------------------------------- 65 67 ! … … 77 79 & CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 78 80 & Computation of a daily mean shortwave for some biogeochemical models) ') 79 81 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 82 !!!!! CHECK For MEDUSA 83 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 80 84 IF( nn_cla == 1 ) & 81 85 & CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) … … 98 102 99 103 IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model 104 IF( lk_medusa ) CALL trc_ini_medusa ! MEDUSA tracers 105 IF( lk_idtra ) CALL trc_ini_idtra ! Idealize tracers 100 106 IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers 101 107 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 108 IF( lk_age ) CALL trc_ini_age ! AGE tracer 102 109 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 103 110 104 111 CALL trc_ice_ini ! Tracers in sea ice 105 112 106 IF( lwp ) THEN 113 # if defined key_debug_medusa 114 IF (lwp) write (numout,*) '------------------------------' 115 IF (lwp) write (numout,*) 'Jpalm - debug' 116 IF (lwp) write (numout,*) ' in trc_init' 117 IF (lwp) write (numout,*) ' sms init OK' 118 IF (lwp) write (numout,*) ' next: open tracer.stat' 119 IF (lwp) write (numout,*) ' ' 120 CALL flush(numout) 121 # endif 122 123 IF( ln_ctl ) THEN 107 124 ! 108 CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 125 IF (narea == 1) THEN 126 ! The tracer.stat file only contains global tracer sum values, if 127 ! it contains anything at all. Hence it only needs to be opened 128 ! and written to on the master PE, not on all PEs. 129 CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE','FORMATTED', & 130 'SEQUENTIAL', -1, numout, lwp , narea ) 131 ENDIF 109 132 ! 110 133 ENDIF 111 134 112 IF( ln_trcdta ) CALL trc_dta_init(jptra) 113 135 # if defined key_debug_medusa 136 IF (lwp) write (numout,*) '------------------------------' 137 IF (lwp) write (numout,*) 'Jpalm - debug' 138 IF (lwp) write (numout,*) ' in trc_init' 139 IF (lwp) write (numout,*) 'open tracer.stat -- OK' 140 IF (lwp) write (numout,*) ' ' 141 CALL flush(numout) 142 # endif 143 144 145 IF( ln_trcdta ) THEN 146 #if defined key_medusa 147 IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 148 IF(lwp) CALL flush(numout) 149 #endif 150 CALL trc_dta_init(jptra) 151 ENDIF 114 152 115 153 IF( ln_rsttr ) THEN 116 154 ! 155 #if defined key_medusa 156 IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 157 IF(lwp) CALL flush(numout) 158 #endif 117 159 CALL trc_rst_read ! restart from a file 118 160 ! 119 161 ELSE 120 162 ! 163 # if defined key_debug_medusa 164 IF (lwp) write (numout,*) '------------------------------' 165 IF (lwp) write (numout,*) 'Jpalm - debug' 166 IF (lwp) write (numout,*) ' Init from file -- will call trc_dta' 167 IF (lwp) write (numout,*) ' ' 168 CALL flush(numout) 169 # endif 170 ! 121 171 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 122 !123 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation124 172 ! 125 173 DO jn = 1, jptra 126 174 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 127 175 jl = n_trc_index(jn) 128 CALL trc_dta( nit000, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 129 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 130 trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:) 176 CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) ) ! read tracer data at nit000 177 trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) 131 178 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 132 179 ! (data used only for initialisation) … … 138 185 ENDIF 139 186 ENDDO 140 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )187 ! 141 188 ENDIF 189 ! 190 # if defined key_debug_medusa 191 IF (lwp) write (numout,*) '------------------------------' 192 IF (lwp) write (numout,*) 'Jpalm - debug' 193 IF (lwp) write (numout,*) ' in trc_init' 194 IF (lwp) write (numout,*) ' before trb = trn' 195 IF (lwp) write (numout,*) ' ' 196 CALL flush(numout) 197 # endif 142 198 ! 143 199 trb(:,:,:,:) = trn(:,:,:,:) 144 200 ! 201 # if defined key_debug_medusa 202 IF (lwp) write (numout,*) '------------------------------' 203 IF (lwp) write (numout,*) 'Jpalm - debug' 204 IF (lwp) write (numout,*) ' in trc_init' 205 IF (lwp) write (numout,*) ' trb = trn -- OK' 206 IF (lwp) write (numout,*) ' ' 207 CALL flush(numout) 208 # endif 209 ! 145 210 ENDIF 146 211 147 212 tra(:,:,:,:) = 0._wp 148 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav ) & ! Partial steps: before horizontal gradient of passive 149 & CALL zps_hde ( nit000, jptra, trn, gtru, gtrv ) ! Partial steps: before horizontal gradient 150 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) & 151 & CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level 152 153 213 ! 214 # if defined key_debug_medusa 215 IF (lwp) write (numout,*) '------------------------------' 216 IF (lwp) write (numout,*) 'Jpalm - debug' 217 IF (lwp) write (numout,*) ' in trc_init' 218 IF (lwp) write (numout,*) ' partial step -- OK' 219 IF (lwp) write (numout,*) ' ' 220 CALL flush(numout) 221 # endif 154 222 ! 155 223 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 156 224 ! 157 225 # if defined key_debug_medusa 226 IF (lwp) write (numout,*) '------------------------------' 227 IF (lwp) write (numout,*) 'Jpalm - debug' 228 IF (lwp) write (numout,*) ' in trc_init' 229 IF (lwp) write (numout,*) ' before initiate tracer contents' 230 IF (lwp) write (numout,*) ' ' 231 CALL flush(numout) 232 # endif 233 ! 158 234 trai(:) = 0._wp ! initial content of all tracers 159 235 DO jn = 1, jptra … … 168 244 WRITE(numout,*) ' *** Total inital content of all tracers ' 169 245 WRITE(numout,*) 246 # if defined key_debug_medusa 247 CALL flush(numout) 248 # endif 249 ! 250 # if defined key_debug_medusa 251 WRITE(numout,*) ' litle check : ', ctrcnm(1) 252 CALL flush(numout) 253 # endif 170 254 DO jn = 1, jptra 171 255 WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) … … 180 264 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 181 265 ENDIF 266 267 IF(lwp) WRITE(numout,*) 268 IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' 269 IF(lwp) WRITE(numout,*) '~~~~~~~' 270 IF(lwp) CALL flush(numout) 271 # if defined key_debug_medusa 272 CALL trc_rst_stat 273 CALL flush(numout) 274 # endif 275 182 276 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 183 277 !
Note: See TracChangeset
for help on using the changeset viewer.
