Changeset 1559 for trunk/NEMO/OPA_SRC/DIA/diaptr.F90
- Timestamp:
- 2009-07-29T16:03:14+02:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DIA/diaptr.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DIA/diaptr.F90
r1413 r1559 4 4 !! Ocean physics: Computes meridonal transports and zonal means 5 5 !!===================================================================== 6 !! History : 9.0 !03-09 (C. Talandier, G. Madec) Original code7 !! 9.0 !06-01 (A. Biastoch) Allow sub-basins computation8 !! 9.0 ! 03-09 (O. Marti) Add fields6 !! History : 1.0 ! 2003-09 (C. Talandier, G. Madec) Original code 7 !! 2.0 ! 2006-01 (A. Biastoch) Allow sub-basins computation 8 !! 3.2 ! 2003-03 (O. Marti, S. Flavoni) Add fields 9 9 !!---------------------------------------------------------------------- 10 10 … … 20 20 USE oce ! ocean dynamics and active tracers 21 21 USE dom_oce ! ocean space and time domain 22 USE daymod ! calandar 23 USE phycst ! physical constants 22 24 USE ldftra_oce ! ocean active tracers: lateral physics 23 USE lib_mpp24 USE in_out_manager25 25 USE dianam 26 USE phycst27 26 USE iom 28 27 USE ioipsl 29 USE daymod 28 USE in_out_manager 29 USE lib_mpp 30 30 31 31 IMPLICIT NONE … … 41 41 PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines 42 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 LOGICAL , PUBLIC :: ln_diaznl = .FALSE. !: Add zonal means and meridional stream functions 47 LOGICAL , PUBLIC :: ln_ptrcomp = .FALSE. !: Add decomposition : overturning (and gyre, soon ...) 48 INTEGER , PUBLIC :: nf_ptr = 15 !: frequency of ptr computation 49 INTEGER , PUBLIC :: nf_ptr_wri = 15 !: frequency of ptr outputs 50 51 REAL(wp), DIMENSION(jpi,jpj), PUBLIC :: abasin, pbasin, ibasin, dbasin, sbasin !: Sub basin masks 52 53 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_adv, pst_adv !: heat and salt poleward transport: advection 54 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_glo, pst_ove_glo, pht_ove_atl, pst_ove_atl, pht_ove_pac, pst_ove_pac, & 55 & pht_ove_ind, pst_ove_ind, pht_ove_ipc, pst_ove_ipc !: heat and salt poleward transport: overturning 56 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ldf, pst_ldf !: heat and salt poleward transport: lateral diffusion 43 ! !!** 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 LOGICAL , PUBLIC :: ln_diaznl = .FALSE. !: Add zonal means and meridional stream functions 47 LOGICAL , PUBLIC :: ln_ptrcomp = .FALSE. !: Add decomposition : overturning (and gyre, soon ...) 48 INTEGER , PUBLIC :: nf_ptr = 15 !: frequency of ptr computation 49 INTEGER , PUBLIC :: nf_ptr_wri = 15 !: frequency of ptr outputs 50 51 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: abasin, pbasin, ibasin, dbasin, sbasin !: Sub basin masks 52 53 ! !!! poleward heat and salt transport 54 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_adv , pst_adv !: advection 55 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ldf , pst_ldf !: lateral diffusion 56 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_glo, pst_ove_glo !: global overturning 57 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_atl, pst_ove_atl !: Atlantic overturning 58 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_pac, pst_ove_pac !: Pacific overturning 59 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_ind, pst_ove_ind !: Indian overturning 60 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_ipc, pst_ove_ipc !: Indo-Pacific overturning 61 REAL(wp), PUBLIC, DIMENSION(jpj) :: ht_glo, ht_atl, ht_ind, ht_pac, ht_ipc !: heat 62 REAL(wp), PUBLIC, DIMENSION(jpj) :: st_glo, st_atl, st_ind, st_pac, st_ipc !: salt 63 64 INTEGER :: niter 65 INTEGER :: nidom_ptr 66 67 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_glo , sn_jk_glo ! global i-mean temperature and salinity 68 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_atl , sn_jk_atl ! Atlantic - - 69 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_pac , sn_jk_pac ! Pacific - - 70 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_ind , sn_jk_ind ! Indian - - 71 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_ipc , sn_jk_ipc ! Indo-Pacific - - 72 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_glo ! global "meridional" Stream-Function 73 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_atl ! Atlantic - - 74 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_pac ! Pacific - - 75 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_ind ! Indian - - 76 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_ipc ! Indo-Pacific - - 77 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_glo, surf_jk_r_glo ! surface of global i-section and its inverse 78 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_atl, surf_jk_r_atl ! surface of Atlantic - - 79 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_pac, surf_jk_r_pac ! surface of Pacific - - 80 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_ind, surf_jk_r_ind ! surface of Indian - - 81 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_ipc, surf_jk_r_ipc ! surface of Indo-Pacific - - 57 82 #if defined key_diaeiv 58 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_glo, pst_eiv_glo, pht_eiv_atl, pst_eiv_atl, pht_eiv_pac, pst_eiv_pac, & 59 & pht_eiv_ind, pst_eiv_ind, pht_eiv_ipc, pst_eiv_ipc !: heat and salt poleward transport: bolus advection 60 #endif 61 REAL(wp), PUBLIC, DIMENSION(jpj) :: ht_glo,ht_atl,ht_ind,ht_pac,ht_ipc !: heat 62 REAL(wp), PUBLIC, DIMENSION(jpj) :: st_glo,st_atl,st_ind,st_pac,st_ipc !: salt 63 64 INTEGER :: niter 65 INTEGER :: nidom_ptr 66 67 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_glo, sn_jk_glo, & !: "zonal" mean temperature and salinity 68 & tn_jk_atl, sn_jk_atl, & 69 & tn_jk_pac, sn_jk_pac, & 70 & tn_jk_ind, sn_jk_ind, & 71 & tn_jk_ipc, sn_jk_ipc, & 72 & v_msf_glo , & !: "meridional" Stream-Function 73 & v_msf_atl , & 74 & v_msf_pac , & 75 & v_msf_ind , & 76 & v_msf_ipc , & 77 & surf_jk_glo , & !: Ocean "zonal" section surface 78 & surf_jk_atl , & 79 & surf_jk_pac , & 80 & surf_jk_ind , & 81 & surf_jk_ipc , & 82 & surf_jk_r_glo , & !: inverse of the ocean "zonal" section surface 83 & surf_jk_r_atl , & 84 & surf_jk_r_pac , & 85 & surf_jk_r_ind , & 86 & surf_jk_r_ipc 87 #if defined key_diaeiv 88 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_glo, v_msf_eiv_atl, v_msf_eiv_pac, & 89 & v_msf_eiv_ind, v_msf_eiv_ipc !: bolus "meridional" Stream-Function 83 ! !!! eddy induced velocity (bolus) 84 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_glo, pst_eiv_glo !: global poleward heat and salt bolus advection 85 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_atl, pst_eiv_atl !: Atlantic - - 86 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_pac, pst_eiv_pac !: Pacific - - 87 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_ind, pst_eiv_ind !: Indian - - 88 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_ipc, pst_eiv_ipc !: Indo-Pacific - - 89 90 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_glo ! global "meridional" bolus Stream-Function 91 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_atl ! Atlantic - - 92 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_pac ! Pacific - - 93 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_ind ! Indian - - 94 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_ipc ! Indo-Pacific - - 90 95 #endif 91 96 … … 94 99 # include "vectopt_loop_substitute.h90" 95 100 !!---------------------------------------------------------------------- 96 !! OPA 9.0 , LOCEAN-IPSL (2005)101 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 97 102 !! $Id$ 98 103 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 106 111 !! 107 112 !! ** Purpose : "zonal" and vertical sum computation of a "meridional" 108 !! flux array113 !! flux array 109 114 !! 110 115 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 111 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)116 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 112 117 !! 113 118 !! ** Action : - p_fval: i-k-mean poleward flux of pva … … 182 187 !! ** Action : - p_fval: i-k-mean poleward flux of pva 183 188 !!---------------------------------------------------------------------- 184 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva! mask flux array at V-point185 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: bmask! Optional 2D basin mask189 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 190 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: bmask ! Optional 2D basin mask 186 191 !! 187 192 INTEGER :: ji, jj, jk ! dummy loop arguments 188 INTEGER , DIMENSION (1) :: ish189 INTEGER , DIMENSION (2) :: ish2190 REAL(wp), DIMENSION(jpj*jpk) :: zwork ! temporary vector for mpp_sum191 193 REAL(wp), DIMENSION(jpj,jpk) :: p_fval ! return function value 194 #if defined key_mpp_mpi 195 INTEGER, DIMENSION(1) :: ish 196 INTEGER, DIMENSION(2) :: ish2 197 REAL(wp), DIMENSION(jpj*jpk) :: zwork ! 1D workspace 198 #endif 192 199 !!-------------------------------------------------------------------- 193 ! 200 ! 194 201 p_fval(:,:) = 0.e0 195 202 ! 196 IF (PRESENT (bmask)) THEN203 IF( PRESENT( bmask ) ) THEN 197 204 DO jk = 1, jpkm1 198 205 DO jj = 2, jpjm1 206 !!gm here, use of tmask_i ==> no need of loop over nldi, nlei.... 199 207 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 200 208 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) & … … 215 223 ! 216 224 #if defined key_mpp_mpi 217 ish(1) = jpj*jpk ; ish2(1) = jpj ;ish2(2) = jpk218 zwork(:) = RESHAPE( p_fval, ish )225 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 226 zwork(:) = RESHAPE( p_fval, ish ) 219 227 CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 220 p_fval(:,:) = RESHAPE( zwork, ish2 )228 p_fval(:,:) = RESHAPE( zwork, ish2 ) 221 229 #endif 222 230 ! 223 231 END FUNCTION ptr_vjk 232 224 233 225 234 FUNCTION ptr_tjk( pta, bmask ) RESULT ( p_fval ) … … 239 248 !! 240 249 INTEGER :: ji, jj, jk ! dummy loop arguments 241 INTEGER, DIMENSION (1) :: ish242 INTEGER, DIMENSION (2) :: ish2243 REAL(wp),DIMENSION(jpj*jpk) :: zwork ! temporary vector for mpp_sum244 250 REAL(wp),DIMENSION(jpj,jpk) :: p_fval ! return function value 251 #if defined key_mpp_mpi 252 INTEGER, DIMENSION(1) :: ish 253 INTEGER, DIMENSION(2) :: ish2 254 REAL(wp),DIMENSION(jpj*jpk) :: zwork ! 1D workspace 255 #endif 245 256 !!-------------------------------------------------------------------- 246 257 ! … … 285 296 INTEGER, INTENT(in) :: kt ! ocean time step index 286 297 !! 287 INTEGER :: jk, jj, ji 288 REAL(wp) :: zsverdrup , &! conversion from m3/s to Sverdrup289 & zpwatt, &! conversion from W to PW290 & zggram! conversion from g to Pg291 REAL(wp), DIMENSION(jpi,jpj,jpk) :: vt, vs298 INTEGER :: jk, jj, ji ! dummy loop 299 REAL(wp) :: zsverdrup ! conversion from m3/s to Sverdrup 300 REAL(wp) :: zpwatt ! conversion from W to PW 301 REAL(wp) :: zggram ! conversion from g to Pg 302 REAL(wp), DIMENSION(jpi,jpj,jpk) :: vt, vs ! 3D workspace 292 303 !!---------------------------------------------------------------------- 293 304 … … 325 336 v_msf_glo(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:) ) 326 337 IF( ln_subbas .AND. ln_diaznl ) THEN 327 v_msf_atl(:,:) = ptr_vjk( vn 328 v_msf_pac(:,:) = ptr_vjk( vn 329 v_msf_ind(:,:) = ptr_vjk( vn 330 v_msf_ipc(:,:) = ptr_vjk( vn 338 v_msf_atl(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 339 v_msf_pac(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 340 v_msf_ind(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 341 v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 331 342 ENDIF 332 343 #else 333 344 v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) ) 334 345 IF( ln_subbas .AND. ln_diaznl ) THEN 335 v_msf_atl(:,:) = ptr_vjk( vn 336 v_msf_pac(:,:) = ptr_vjk( vn 337 v_msf_ind(:,:) = ptr_vjk( vn 338 v_msf_ipc(:,:) = ptr_vjk( vn 346 v_msf_atl(:,:) = ptr_vjk( vn(:,:,:), abasin(:,:)*sbasin(:,:) ) 347 v_msf_pac(:,:) = ptr_vjk( vn(:,:,:), pbasin(:,:)*sbasin(:,:) ) 348 v_msf_ind(:,:) = ptr_vjk( vn(:,:,:), ibasin(:,:)*sbasin(:,:) ) 349 v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:), dbasin(:,:)*sbasin(:,:) ) 339 350 ENDIF 340 351 #endif … … 474 485 ENDIF 475 486 ENDIF 476 477 ! outputs 478 CALL dia_ptr_wri( kt ) 479 487 ! 488 CALL dia_ptr_wri( kt ) ! outputs 489 ! 480 490 ENDIF 481 482 ! Close the file 483 IF( kt == nitend ) CALL histclo( numptr ) 491 ! 492 IF( kt == nitend ) CALL histclo( numptr ) ! Close the file 484 493 ! 485 494 END SUBROUTINE dia_ptr … … 492 501 !! ** Purpose : Initialization, namelist read 493 502 !!---------------------------------------------------------------------- 503 INTEGER :: inum ! temporary logical unit 504 #if defined key_mpp_mpi 505 INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 506 #endif 507 !! 494 508 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nf_ptr, nf_ptr_wri 495 INTEGER :: inum ! temporary logical unit 496 #if defined key_mpp_mpi 497 INTEGER, DIMENSION (1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 498 #endif 499 !!---------------------------------------------------------------------- 500 501 ! Read Namelist namptr : poleward transport parameters 502 REWIND ( numnam ) 509 !!---------------------------------------------------------------------- 510 511 REWIND ( numnam ) ! Read Namelist namptr : poleward transport parameters 503 512 READ ( numnam, namptr ) 504 513 505 ! Control print 506 IF(lwp) THEN 514 IF(lwp) THEN ! Control print 507 515 WRITE(numout,*) 508 516 WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization' 509 517 WRITE(numout,*) '~~~~~~~~~~~~' 510 WRITE(numout,*) ' 511 WRITE(numout,*) ' Switch for ptr diagnostic (T) or not (F) ln_diaptr= ', ln_diaptr512 WRITE(numout,*) ' Atla/Paci/Ind basins computation ln_subbas= ', ln_subbas513 WRITE(numout,*) ' Frequency of computation nf_ptr= ', nf_ptr514 WRITE(numout,*) ' Frequency of outputsnf_ptr_wri = ', nf_ptr_wri518 WRITE(numout,*) ' Namelist namptr : set ptr parameters' 519 WRITE(numout,*) ' Switch for ptr diagnostic (T) or not (F) ln_diaptr = ', ln_diaptr 520 WRITE(numout,*) ' Atl/Pac/Ind basins computation ln_subbas = ', ln_subbas 521 WRITE(numout,*) ' Frequency of computation nf_ptr = ', nf_ptr 522 WRITE(numout,*) ' Frequency of outputs nf_ptr_wri = ', nf_ptr_wri 515 523 ENDIF 516 524 517 ! 518 ! Define MPI communicator for zonal sum 519 ! 520 IF( lk_mpp ) THEN 521 CALL mpp_ini_znl 522 ENDIF 523 524 IF( ln_subbas ) THEN ! load sub-basin mask 525 IF( lk_mpp ) CALL mpp_ini_znl ! Define MPI communicator for zonal sum 526 527 IF( ln_subbas ) THEN ! load sub-basin mask 525 528 CALL iom_open( 'subbasins', inum ) 526 529 CALL iom_get( inum, jpdom_data, 'atlmsk', abasin ) ! Atlantic basin … … 533 536 ENDIF 534 537 538 !!gm CAUTION : this is only valid in fixed volume case ! 539 535 540 ! inverse of the ocean "zonal" v-point section 536 541 surf_jk_glo(:,:) = ptr_tjk( tmask(:,:,:) ) … … 580 585 nidom_ptr = FLIO_DOM_NONE 581 586 #endif 582 587 ! 583 588 END SUBROUTINE dia_ptr_init 584 589 … … 632 637 633 638 zdt = rdt 634 IF( nacc == 1 ) zdt = rdtmin639 IF( nacc == 1 ) zdt = rdtmin 635 640 636 641 ! Reference latitude … … 670 675 671 676 ! ! ======================= 672 ELSE ! OTHER configurations zjulian = zjulian - adatrj 673 ! set calendar origin to the beginning of the experiment 677 ELSE ! OTHER configurations 674 678 ! ! ======================= 675 679 zphi(:) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line
Note: See TracChangeset
for help on using the changeset viewer.
