Changeset 508 for trunk/NEMO/OPA_SRC/DIA/diaptr.F90
- Timestamp:
- 2006-10-03T17:58:55+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DIA/diaptr.F90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DIA/diaptr.F90
r460 r508 5 5 !! (please no more than 2 lines) 6 6 !!===================================================================== 7 !! History : 9.0 ! 03-09 (C. Talandir, G. Madec) Original code 8 !! 9.0 ! 06-01 (A. Biastoch) Allow sub-basins computation 9 !!---------------------------------------------------------------------- 10 7 11 !!---------------------------------------------------------------------- 8 12 !! dia_ptr : Poleward Transport Diagnostics module … … 14 18 !! : flux array; Generic interface: ptr_vj_3d, ptr_vj_2d 15 19 !!---------------------------------------------------------------------- 16 !! History :17 !! 9.0 ! 03-09 (C. Talandir, G. Madec) Original code18 !! 9.0 ! 06-01 (A. Biastoch) Allow sub-basins computation19 !!----------------------------------------------------------------------20 !! * Modules used21 20 USE oce ! ocean dynamics and active tracers 22 21 USE dom_oce ! ocean space and time domain … … 26 25 USE dianam 27 26 USE phycst 28 USE ioipsl ! NetCDF IPSL library 27 USE iom 28 USE ioipsl 29 29 USE daymod 30 30 … … 36 36 END INTERFACE 37 37 38 !! * Routine accessibility 39 PUBLIC dia_ptr_init ! call in opa module 40 PUBLIC dia_ptr ! call in step module 41 PUBLIC ptr_vj ! call by tra_ldf & tra_adv routines 42 PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines 43 44 !! * Share Module variables 45 LOGICAL, PUBLIC :: & !!! ** init namelist (namptr) ** 46 ln_diaptr = .FALSE., & !: Poleward transport flag (T) or not (F) 47 ln_subbas = .FALSE. !: Atlantic/Pacific/Indian basins calculation 48 INTEGER, PUBLIC :: & !!: ** ptr namelist (namptr) ** 49 nf_ptr = 15 !: frequency of ptr computation 50 REAL(wp), PUBLIC, DIMENSION(jpj) :: & !!: poleward transport 51 pht_adv, pst_adv, & !: heat and salt: advection 52 pht_ove, pst_ove, & !: heat and salt: overturning 53 pht_ldf, pst_ldf, & !: heat and salt: lateral diffusion 54 #if defined key_diaeiv 55 pht_eiv, pst_eiv, & !: heat and salt: bolus advection 56 #endif 57 ht_atl,ht_ind,ht_pac, & !: heat 58 st_atl,st_ind,st_pac !: salt 59 REAL(wp),DIMENSION(jpi,jpj) :: & 60 abasin,pbasin,ibasin !: return function value 38 PUBLIC dia_ptr_init ! call in opa module 39 PUBLIC dia_ptr ! call in step module 40 PUBLIC ptr_vj ! call by tra_ldf & tra_adv routines 41 PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines 42 43 !!! ** init namelist (namptr) 44 LOGICAL , PUBLIC :: ln_diaptr = .FALSE. !: Poleward transport flag (T) or not (F) 45 LOGICAL , PUBLIC :: ln_subbas = .FALSE. !: Atlantic/Pacific/Indian basins calculation 46 INTEGER , PUBLIC :: nf_ptr = 15 !: frequency of ptr computation 47 48 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_adv, pst_adv !: heat and salt poleward transport: advection 49 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove, pst_ove !: heat and salt poleward transport: overturning 50 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ldf, pst_ldf !: heat and salt poleward transport: lateral diffusion 51 #if defined key_diaeiv 52 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv, pst_eiv !: heat and salt poleward transport: bolus advection 53 #endif 54 REAL(wp), PUBLIC, DIMENSION(jpj) :: ht_atl,ht_ind,ht_pac !: heat 55 REAL(wp), PUBLIC, DIMENSION(jpj) :: st_atl,st_ind,st_pac !: salt 56 61 57 62 58 63 !! Module variables 64 REAL(wp), DIMENSION(jpj,jpk) :: & 65 tn_jk , sn_jk , & !: "zonal" mean temperature and salinity 66 v_msf_atl , & !: "meridional" Stream-Function 67 v_msf_glo , & !: "meridional" Stream-Function 68 v_msf_ipc , & !: "meridional" Stream-Function 69 #if defined key_diaeiv 70 v_msf_eiv , & !: bolus "meridional" Stream-Function 71 #endif 72 surf_jk_r !: inverse of the ocean "zonal" section surface 59 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk , sn_jk , & !: "zonal" mean temperature and salinity 60 & v_msf_atl , & !: "meridional" Stream-Function 61 & v_msf_glo , & !: "meridional" Stream-Function 62 & v_msf_ipc , & !: "meridional" Stream-Function 63 & surf_jk_r !: inverse of the ocean "zonal" section surface 64 #if defined key_diaeiv 65 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv !: bolus "meridional" Stream-Function 66 #endif 67 REAL(wp), DIMENSION(jpi,jpj) :: abasin, pbasin, ibasin !: return function value 73 68 74 69 !! * Substitutions … … 78 73 !! OPA 9.0 , LOCEAN-IPSL (2005) 79 74 !! $Header$ 80 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt75 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 81 76 !!---------------------------------------------------------------------- 82 77 … … 94 89 !! 95 90 !! ** Action : - p_fval: i-k-mean poleward flux of pva 96 !! 97 !!---------------------------------------------------------------------- 98 !! * arguments 99 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: & 100 pva ! mask flux array at V-point 101 102 !! * local declarations 103 INTEGER :: ji, jj, jk ! dummy loop arguments 104 INTEGER :: ijpj ! ??? 105 REAL(wp),DIMENSION(jpj) :: & 106 p_fval ! function value 91 !!---------------------------------------------------------------------- 92 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 93 !! 94 INTEGER :: ji, jj, jk ! dummy loop arguments 95 INTEGER :: ijpj ! ??? 96 REAL(wp), DIMENSION(jpj) :: p_fval ! function value 107 97 !!-------------------------------------------------------------------- 108 98 ! 109 99 ijpj = jpj 110 100 p_fval(:) = 0.e0 … … 116 106 END DO 117 107 END DO 118 108 ! 119 109 IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj ) !!bug I presume 120 110 ! 121 111 END FUNCTION ptr_vj_3d 122 123 112 124 113 … … 134 123 !! 135 124 !! ** Action : - p_fval: i-k-mean poleward flux of pva 136 !! 137 !!---------------------------------------------------------------------- 138 !! * arguments 139 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: & 140 pva ! mask flux array at V-point 141 142 !! * local declarations 143 INTEGER :: ji,jj ! dummy loop arguments 144 INTEGER :: ijpj ! ??? 145 REAL(wp),DIMENSION(jpj) :: & 146 p_fval ! function value 125 !!---------------------------------------------------------------------- 126 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 127 !! 128 INTEGER :: ji,jj ! dummy loop arguments 129 INTEGER :: ijpj ! ??? 130 REAL(wp), DIMENSION(jpj) :: p_fval ! function value 147 131 !!-------------------------------------------------------------------- 148 132 ! 149 133 ijpj = jpj 150 134 p_fval(:) = 0.e0 … … 154 138 END DO 155 139 END DO 156 140 ! 157 141 IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj ) !!bug I presume 158 159 END FUNCTION ptr_vj_2d 160 142 ! 143 END FUNCTION ptr_vj_2d 161 144 162 145 … … 171 154 !! 172 155 !! ** Action : - p_fval: i-k-mean poleward flux of pva 173 !! 174 !!---------------------------------------------------------------------- 175 !! * arguments 176 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: & 177 pva ! mask flux array at V-point 178 179 !! * local declarations 180 INTEGER :: ji, jj, jk ! dummy loop arguments 181 INTEGER, DIMENSION (1) :: ish 182 INTEGER, DIMENSION (2) :: ish2 183 REAL(wp),DIMENSION(jpj*jpk) :: & 184 zwork ! temporary vector for mpp_sum 185 REAL(wp),DIMENSION(jpj,jpk) :: & 186 p_fval ! return function value 156 !!---------------------------------------------------------------------- 157 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 158 !! 159 INTEGER :: ji, jj, jk ! dummy loop arguments 160 INTEGER , DIMENSION (1) :: ish 161 INTEGER , DIMENSION (2) :: ish2 162 REAL(wp), DIMENSION(jpj*jpk) :: zwork ! temporary vector for mpp_sum 163 REAL(wp), DIMENSION(jpj,jpk) :: p_fval ! return function value 187 164 !!-------------------------------------------------------------------- 188 165 ! 189 166 p_fval(:,:) = 0.e0 190 167 ! 191 168 DO jk = 1, jpkm1 192 169 DO jj = 2, jpjm1 … … 197 174 END DO 198 175 END DO 199 176 ! 200 177 IF(lk_mpp) THEN 201 178 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk … … 204 181 p_fval(:,:)= RESHAPE( zwork, ish2 ) 205 182 END IF 206 183 ! 207 184 END FUNCTION ptr_vjk 185 208 186 209 187 FUNCTION ptr_vtjk( pva ) RESULT ( p_fval ) … … 218 196 !! 219 197 !! ** Action : - p_fval: i-k-mean poleward flux of pva 220 !! 221 !!---------------------------------------------------------------------- 222 !! * arguments 223 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: & 224 pva ! mask flux array at V-point 225 226 !! * local declarations 227 INTEGER :: ji, jj, jk ! dummy loop arguments 228 INTEGER, DIMENSION (1) :: ish 229 INTEGER, DIMENSION (2) :: ish2 230 REAL(wp),DIMENSION(jpj*jpk) :: & 231 zwork ! temporary vector for mpp_sum 232 REAL(wp),DIMENSION(jpj,jpk) :: & 233 p_fval ! return function value 198 !!---------------------------------------------------------------------- 199 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 200 !! 201 INTEGER :: ji, jj, jk ! dummy loop arguments 202 INTEGER, DIMENSION (1) :: ish 203 INTEGER, DIMENSION (2) :: ish2 204 REAL(wp),DIMENSION(jpj*jpk) :: zwork ! temporary vector for mpp_sum 205 REAL(wp),DIMENSION(jpj,jpk) :: p_fval ! return function value 234 206 !!-------------------------------------------------------------------- 235 207 ! 236 208 p_fval(:,:) = 0.e0 237 209 DO jk = 1, jpkm1 … … 251 223 p_fval(:,:)= RESHAPE(zwork,ish2) 252 224 END IF 253 225 ! 254 226 END FUNCTION ptr_vtjk 255 227 … … 259 231 !! *** ROUTINE dia_ptr *** 260 232 !!---------------------------------------------------------------------- 261 !! * Moudules used262 USE ioipsl263 264 !! * Argument265 233 INTEGER, INTENT(in) :: kt ! ocean time step index 266 267 !! * Local variables 268 INTEGER :: jk,jj,ji ! dummy loop 269 REAL(wp) :: & 270 zsverdrup, & ! conversion from m3/s to Sverdrup 271 zpwatt, & ! conversion from W to PW 272 zggram ! conversion from g to Pg 234 !! 235 INTEGER :: jk, jj, ji ! dummy loop 236 REAL(wp) :: zsverdrup, & ! conversion from m3/s to Sverdrup 237 & zpwatt, & ! conversion from W to PW 238 & zggram ! conversion from g to Pg 273 239 274 240 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & … … 277 243 vs_atl, vs_pac, vs_ind, & 278 244 zv_eiv 279 CHARACTER (len=32) :: & 280 clnam = 'subbasins.nc' 281 INTEGER :: itime,inum,ipi,ipj,ipk ! temporary integer 282 INTEGER, DIMENSION (1) :: istep 283 REAL(wp) :: zdate0,zsecond,zdt ! temporary scalars 284 REAL(wp), DIMENSION(jpidta,jpjdta) :: & 285 zlamt, zphit, zdta ! temporary workspace (NetCDF read) 286 REAL(wp), DIMENSION(jpk) :: & 287 zdept ! temporary workspace (NetCDF read) 245 INTEGER :: inum ! temporary logical unit 288 246 !!---------------------------------------------------------------------- 289 247 … … 293 251 zpwatt = 1.e-15 294 252 zggram = 1.e-6 295 ipi = jpidta296 ipj = jpjdta297 ipk = 1298 itime = 1299 zsecond = 0.e0300 zdate0 = 0.e0301 253 302 254 # if defined key_diaeiv … … 315 267 IF( ln_subbas ) THEN ! Basins computation 316 268 317 IF( kt == nit000 ) THEN ! load basin mask 318 itime = 1 319 ipi = jpidta 320 ipj = jpjdta 321 ipk = 1 322 zdt = 0.e0 323 istep = 0 324 clnam = 'subbasins.nc' 325 326 CALL flinopen(clnam,1,jpidta,1,jpjdta,.FALSE.,ipi,ipj, & 327 & ipk,zlamt,zphit,zdept,itime,istep,zdate0,zdt,inum) 328 329 ! get basins: 330 abasin (:,:) = 0.e0 331 pbasin (:,:) = 0.e0 332 ibasin (:,:) = 0.e0 333 334 ! Atlantic basin 335 CALL flinget(inum,'atlmsk',jpidta,jpjdta,1,itime,1, & 336 & 0,1,jpidta,1,jpjdta,zdta(:,:)) 337 DO jj = 1, nlcj ! interior values 338 DO ji = 1, nlci 339 abasin (ji,jj) = zdta( mig(ji), mjg(jj) ) 340 END DO 341 END DO 342 343 ! Pacific basin 344 CALL flinget(inum,'pacmsk',jpidta,jpjdta,1,itime,1, & 345 & 0,1,jpidta,1,jpjdta,zdta(:,:)) 346 DO jj = 1, nlcj ! interior values 347 DO ji = 1, nlci 348 pbasin (ji,jj) = zdta( mig(ji), mjg(jj) ) 349 END DO 350 END DO 351 352 ! Indian basin 353 CALL flinget(inum,'indmsk',jpidta,jpjdta,1,itime,1, & 354 & 0,1,jpidta,1,jpjdta,zdta(:,:)) 355 DO jj = 1, nlcj ! interior values 356 DO ji = 1, nlci 357 ibasin (ji,jj) = zdta( mig(ji), mjg(jj) ) 358 END DO 359 END DO 360 361 CALL flinclo(inum) 362 269 IF( kt == nit000 ) THEN ! load sub-basin mask 270 CALL iom_open( 'subbasins', inum ) 271 CALL iom_get( inum, jpdom_data, 'atlmsk', abasin ) ! Atlantic basin 272 CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin ) ! Pacific basin 273 CALL iom_get( inum, jpdom_data, 'indmsk', ibasin ) ! Indian basin 274 CALL iom_close( inum ) 363 275 ENDIF 364 276 … … 396 308 #endif 397 309 IF( ln_subbas ) THEN 398 v_msf_atl(:,:) = ptr_vjk( v_atl (:,:,:) )399 v_msf_ipc(:,:) = ptr_vjk( v_ipc (:,:,:) )400 ht_atl(:) = SUM( ptr_vjk( vt_atl(:,:,:)),2 )401 ht_pac(:) = SUM( ptr_vjk( vt_pac(:,:,:)),2 )402 ht_ind(:) = SUM( ptr_vjk( vt_ind(:,:,:)),2 )403 st_atl(:) = SUM( ptr_vjk( vs_atl(:,:,:)),2 )404 st_pac(:) = SUM( ptr_vjk( vs_pac(:,:,:)),2 )405 st_ind(:) = SUM( ptr_vjk( vs_ind(:,:,:)),2 )310 v_msf_atl(:,:) = ptr_vjk( v_atl (:,:,:) ) 311 v_msf_ipc(:,:) = ptr_vjk( v_ipc (:,:,:) ) 312 ht_atl(:) = SUM( ptr_vjk( vt_atl(:,:,:)), 2 ) 313 ht_pac(:) = SUM( ptr_vjk( vt_pac(:,:,:)), 2 ) 314 ht_ind(:) = SUM( ptr_vjk( vt_ind(:,:,:)), 2 ) 315 st_atl(:) = SUM( ptr_vjk( vs_atl(:,:,:)), 2 ) 316 st_pac(:) = SUM( ptr_vjk( vs_pac(:,:,:)), 2 ) 317 st_ind(:) = SUM( ptr_vjk( vs_ind(:,:,:)), 2 ) 406 318 ENDIF 407 319 … … 466 378 ! Close the file 467 379 IF( kt == nitend ) CALL histclo( numptr ) 468 380 ! 469 381 END SUBROUTINE dia_ptr 470 382 … … 475 387 !! 476 388 !! ** Purpose : Initialization, namelist read 477 !!478 389 !!---------------------------------------------------------------------- 479 390 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_1 ! temporary workspace … … 485 396 REWIND ( numnam ) 486 397 READ ( numnam, namptr ) 487 488 398 489 399 ! Control print … … 513 423 !! 514 424 !! ** Method : NetCDF file 515 !! 516 !!---------------------------------------------------------------------- 517 !! * Arguments 425 !!---------------------------------------------------------------------- 518 426 INTEGER, INTENT(in) :: kt ! ocean time-step index 519 520 !! * Save variables 427 !! 521 428 INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw, ndex(1) 522 429 523 !! * Local variables 524 CHARACTER (len=40) :: & 525 clhstnam, clop ! temporary names 526 INTEGER :: iline, it, ji ! 527 REAL(wp) :: & 528 zsto, zout, zdt, zmax, & ! temporary scalars 529 zjulian 430 CHARACTER (len=40) :: clhstnam, clop ! temporary names 431 INTEGER :: iline, it, ji ! 432 REAL(wp) :: zsto, zout, zdt, zmax, zjulian ! temporary scalars 530 433 REAL(wp), DIMENSION(jpj) :: zphi, zfoo 531 434 !!---------------------------------------------------------------------- … … 720 623 721 624 ENDIF 722 625 ! 723 626 END SUBROUTINE dia_ptr_wri 724 627
Note: See TracChangeset
for help on using the changeset viewer.
