Changeset 2578 for branches/TAM_V3_2_2
- Timestamp:
- 2011-02-03T19:33:40+01:00 (13 years ago)
- Location:
- branches/TAM_V3_2_2
- Files:
-
- 103 added
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/TAM_V3_2_2/NEMO/OPA_SRC/DOM/daymod.F90
r1730 r2578 39 39 PUBLIC day ! called by step.F90 40 40 PUBLIC day_init ! called by istate.F90 41 42 INTEGER :: nsecd, nsecd05, ndt, ndt05 41 PUBLIC day_mth ! called by daymod_tam.F90 42 43 INTEGER, PUBLIC :: nsecd, ndt, ndt05 44 INTEGER :: nsecd05 43 45 44 46 !!---------------------------------------------------------------------- … … 239 241 ENDIF 240 242 241 IF( lrst_oce ) CALL day_rst( kt, 'WRITE' ) 243 CALL rst_opn( kt ) ! Open the restart file if needed and control lrst_oce 244 IF( lrst_oce ) CALL day_rst( kt, 'WRITE' ) ! write day restart information 242 245 ! 243 246 END SUBROUTINE day -
branches/TAM_V3_2_2/NEMO/OPA_SRC/DYN/dynadv.F90
r1601 r2578 23 23 24 24 PUBLIC dyn_adv ! routine called by step module 25 PUBLIC dyn_adv_ctl ! routine called by dynadv_tam module 25 26 26 27 LOGICAL, PUBLIC :: ln_dynadv_vec = .TRUE. ! vector form flag -
branches/TAM_V3_2_2/NEMO/OPA_SRC/DYN/dynhpg.F90
r1601 r2578 51 51 REAL(wp), PUBLIC :: rn_gamma = 0.e0 !: weighting coefficient 52 52 LOGICAL , PUBLIC :: ln_dynhpg_imp = .FALSE. !: semi-implicite hpg flag 53 INTEGER , PUBLIC :: nn_dynhpg_rst = 0 !: add dynhpg implicit variables in restart ot not 54 55 INTEGER :: nhpg = 0 ! = 0 to 6, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) 53 54 INTEGER , PUBLIC :: nhpg = 0 ! = 0 to 6, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) 56 55 57 56 !! * Substitutions … … 124 123 ! NAMELIST/namdyn_hpg/ ln_hpg_zco , ln_hpg_zps , ln_hpg_sco, ln_hpg_hel, & 125 124 ! & ln_hpg_wdj , ln_hpg_djc , ln_hpg_rot, rn_gamma , & 126 ! & ln_dynhpg_imp , nn_dynhpg_rst125 ! & ln_dynhpg_imp 127 126 !!---------------------------------------------------------------------- 128 127 … … 144 143 WRITE(numout,*) ' weighting coeff. (wdj scheme) rn_gamma = ', rn_gamma 145 144 WRITE(numout,*) ' time stepping: centered (F) or semi-implicit (T) ln_dynhpg_imp = ', ln_dynhpg_imp 146 WRITE(numout,*) ' add in restart dynhpg semi-implicit variable nn_dynhpg_rst = ', nn_dynhpg_rst147 145 ENDIF 148 149 IF( .NOT. ln_dynhpg_imp ) nn_dynhpg_rst = 0 ! force no adding dynhpg implicit variables in restart150 146 151 147 IF( lk_vvl .AND. .NOT. ln_hpg_sco ) THEN -
branches/TAM_V3_2_2/NEMO/OPA_SRC/DYN/sshwzv.F90
r1756 r2578 27 27 USE diaar5, ONLY : lk_diaar5 28 28 USE iom 29 USE agrif_opa_interp 30 USE agrif_opa_update 29 31 30 32 IMPLICIT NONE … … 137 139 138 140 CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity 139 IF( n_cla == 1 ) CALL div_cla( kt ) ! Cross Land Advection (Update Hor. divergence)141 IF( n_cla == 1 ) CALL div_cla( kt ) ! Cross Land Advection (Update Hor. divergence) 140 142 141 143 ! set time step size (Euler/Leapfrog) … … 145 147 zraur = 1. / rau0 146 148 147 ! !------------------------------! 148 ! ! After Sea Surface Height ! 149 ! !------------------------------! 150 zhdiv(:,:) = 0.e0 151 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 152 zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 153 END DO 154 155 ! ! Sea surface elevation time stepping 156 ssha(:,:) = ( sshb(:,:) - z2dt * ( zraur * emp(:,:) + zhdiv(:,:) ) ) * tmask(:,:,1) 157 149 ! !------------------------------! 150 ! ! After Sea Surface Height ! 151 ! !------------------------------! 152 zhdiv(:,:) = 0.e0 153 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 154 zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 155 END DO 156 157 ! ! Sea surface elevation time stepping 158 ssha(:,:) = ( sshb(:,:) - z2dt * ( zraur * emp(:,:) + zhdiv(:,:) ) ) * tmask(:,:,1) 159 160 # if defined key_agrif 161 CALL agrif_ssh(kt) 162 # endif 158 163 #if defined key_obc 159 # if defined key_agrif160 164 IF ( Agrif_Root() ) THEN 165 ssha(:,:) = ssha(:,:) * obctmsk(:,:) 166 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 167 ENDIF 161 168 # endif 162 ssha(:,:) = ssha(:,:) * obctmsk(:,:) 163 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 164 # if defined key_agrif 165 ENDIF 166 # endif 167 #endif 168 169 ! ! Sea Surface Height at u-,v- and f-points (vvl case only) 170 IF( lk_vvl ) THEN ! (required only in key_vvl case) 171 DO jj = 1, jpjm1 172 DO ji = 1, jpim1 ! NO Vector Opt. 173 sshu_a(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) ) & 174 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj) & 175 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) ) 176 sshv_a(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) ) & 177 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj ) & 178 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) ) 179 sshf_a(ji,jj) = 0.25 * umask(ji,jj,1) * umask (ji,jj+1,1) & 180 & * ( ssha(ji ,jj) + ssha(ji ,jj+1) & 181 & + ssha(ji+1,jj) + ssha(ji+1,jj+1) ) 182 END DO 183 END DO 184 CALL lbc_lnk( sshu_a, 'U', 1. ) ! Boundaries conditions 185 CALL lbc_lnk( sshv_a, 'V', 1. ) 186 CALL lbc_lnk( sshf_a, 'F', 1. ) 187 ENDIF 169 170 ! ! Sea Surface Height at u-,v- and f-points (vvl case only) 171 IF( lk_vvl ) THEN ! (required only in key_vvl case) 172 DO jj = 1, jpjm1 173 DO ji = 1, jpim1 ! NO Vector Opt. 174 sshu_a(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) ) & 175 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj) & 176 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) ) 177 sshv_a(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) ) & 178 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj ) & 179 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) ) 180 sshf_a(ji,jj) = 0.25 * umask(ji,jj,1) * umask (ji,jj+1,1) & 181 & * ( ssha(ji ,jj) + ssha(ji ,jj+1) & 182 & + ssha(ji+1,jj) + ssha(ji+1,jj+1) ) 183 END DO 184 END DO 185 CALL lbc_lnk( sshu_a, 'U', 1. ) ! Boundaries conditions 186 CALL lbc_lnk( sshv_a, 'V', 1. ) 187 CALL lbc_lnk( sshf_a, 'F', 1. ) 188 ENDIF 188 189 189 190 ! !------------------------------! … … 197 198 END DO 198 199 ! 199 CALL iom_put( "woce", wn ) ! vertical velocity200 CALL iom_put( "ssh" , sshn ) ! sea surface height201 CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) ) ! square of sea surface height202 IF( lk_diaar5 ) THEN203 z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:)204 DO jk = 1, jpk205 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)206 END DO207 CALL iom_put( "w_masstr" , z3d ) ! vertical mass transport208 CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) ! square of vertical mass transport209 ENDIF200 CALL iom_put( "woce", wn ) ! vertical velocity 201 CALL iom_put( "ssh" , sshn ) ! sea surface height 202 CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) ) ! square of sea surface height 203 IF( lk_diaar5 ) THEN 204 z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:) 205 DO jk = 1, jpk 206 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 207 END DO 208 CALL iom_put( "w_masstr" , z3d ) ! vertical mass transport 209 CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) ! square of vertical mass transport 210 ENDIF 210 211 ! 211 212 END SUBROUTINE ssh_wzv … … 279 280 ENDIF 280 281 ! 282 #if defined key_agrif 283 ! Update velocity at AGRIF zoom boundaries 284 IF (.NOT.Agrif_Root()) CALL Agrif_Update_Dyn( kt ) 285 #endif 286 281 287 IF(ln_ctl) CALL prt_ctl(tab2d_1=sshb , clinfo1=' sshb - : ', mask1=tmask, ovlap=1 ) 282 288 ! -
branches/TAM_V3_2_2/NEMO/OPA_SRC/TRA/eosbn2.F90
r1613 r2578 16 16 !! - ! 2003-08 (G. Madec) F90, free form 17 17 !! 3.0 ! 2006-08 (G. Madec) add tfreez function 18 !! ! 2009-03 (M. Balmaseda) compute refrence rho prof 18 19 !!---------------------------------------------------------------------- 19 20 … … 24 25 !! volumic mass 25 26 !! eos_insitu_2d : Compute the in situ density for 2d fields 27 !! eos_insitu_pot_1pt : Compute the in situ density for a single point 26 28 !! eos_bn2 : Compute the Brunt-Vaisala frequency 27 29 !! tfreez : Compute the surface freezing temperature 28 30 !! eos_init : set eos parameters (namelist) 31 !! eos_rprof : Compute the in situ density of a reference profile 29 32 !!---------------------------------------------------------------------- 30 33 USE dom_oce ! ocean space and time domain … … 56 59 57 60 REAL(wp), PUBLIC :: ralpbet !: alpha / beta ratio 61 INTEGER, PUBLIC :: neos_init = 0 !: control flag for initialization 58 62 59 63 !! * Substitutions … … 592 596 !!---------------------------------------------------------------------- 593 597 ! 598 neos_init = 1 ! indicate that the initialization has been done 599 594 600 REWIND( numnam ) ! Read Namelist nameos : equation of state 595 601 READ ( numnam, nameos ) -
branches/TAM_V3_2_2/NEMO/OPA_SRC/TRA/tradmp.F90
r1601 r2578 41 41 42 42 PUBLIC tra_dmp ! routine called by step.F90 43 PUBLIC cofdis, dtacof, dtacof_zoom 43 44 44 45 #if ! defined key_agrif … … 315 316 resto(:,:,:) = 0.e0 316 317 317 !!-----------------------------------------!318 ! !-----------------------------------------! 318 319 IF( nn_hdmp > 0 ) THEN ! Damping poleward of 'nn_hdmp' degrees ! 319 320 ! !-----------------------------------------! -
branches/TAM_V3_2_2/NEMO/OPA_SRC/TRA/tranxt.F90
r1601 r2578 38 38 USE agrif_opa_update 39 39 USE agrif_opa_interp 40 USE obc_oce 40 41 41 42 IMPLICIT NONE … … 44 45 PUBLIC tra_nxt ! routine called by step.F90 45 46 46 REAL(wp), DIMENSION(jpk) :: r2dt_t ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler)47 REAL(wp), PUBLIC, DIMENSION(jpk) :: r2dt_t ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler) 47 48 48 49 !! * Substitutions … … 101 102 ! 102 103 #if defined key_obc 103 CALL obc_tra( kt )! OBC open boundaries104 IF( lk_obc ) CALL obc_tra( kt ) ! OBC open boundaries 104 105 #endif 105 106 #if defined key_bdy -
branches/TAM_V3_2_2/NEMO/OPA_SRC/TRA/traqsr.F90
r1756 r2578 32 32 33 33 PUBLIC tra_qsr ! routine called by step.F90 (ln_traqsr=T) 34 34 PUBLIC tra_qsr_init ! routine called by traqsr_tam.F90 (ln_traqsr=T) 35 35 ! !!* Namelist namtra_qsr: penetrative solar radiation 36 36 LOGICAL , PUBLIC :: ln_traqsr = .TRUE. !: light absorption (qsr) flag … … 45 45 46 46 ! Module variables 47 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read)48 INTEGER ::nksr ! levels below which the light cannot penetrate ( depth larger than 391 m)49 REAL(wp), DIMENSION(3,61) :: rkrgb !: tabulated attenuation coefficients for RGB absorption47 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) 48 INTEGER, PUBLIC :: nksr ! levels below which the light cannot penetrate ( depth larger than 391 m) 49 REAL(wp), PUBLIC, DIMENSION(3,61) :: rkrgb !: tabulated attenuation coefficients for RGB absorption 50 50 51 51 !! * Substitutions -
branches/TAM_V3_2_2/NEMO/OPA_SRC/ZDF/zdftke.F90
r1756 r2578 87 87 88 88 REAL(wp), DIMENSION(jpi,jpj) :: htau ! depth of tke penetration (nn_htau) 89 REAL(wp), DIMENSION(jpi,jpj,jpk) :: en! now turbulent kinetic energy [m2/s2]89 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: en ! now turbulent kinetic energy [m2/s2] 90 90 REAL(wp), DIMENSION(jpi,jpj,jpk) :: dissl ! now mixing lenght of dissipation 91 91 -
branches/TAM_V3_2_2/NEMO/OPA_SRC/ZDF/zdftke_old.F90
r1617 r2578 31 31 !! zdf_tke_old : update momentum and tracer Kz from a tke scheme 32 32 !! zdf_tke_init : initialization, namelist read, and parameters control 33 !! tke_ rst: read/write tke restart in ocean restart file33 !! tke_old_rst : read/write tke restart in ocean restart file 34 34 !!---------------------------------------------------------------------- 35 35 USE oce ! ocean dynamics and active tracers … … 49 49 50 50 PUBLIC zdf_tke_old ! routine called in step module 51 PUBLIC tke_old_rst ! routine called in asm module 51 52 52 53 LOGICAL , PUBLIC, PARAMETER :: lk_zdftke_old = .TRUE. !: TKE vertical mixing flag … … 66 67 67 68 ! !!! ** Namelist namzdf_tke ** 68 LOGICAL :: ln_rstke = .FALSE. ! =T restart with tke from a run without tke69 69 LOGICAL :: ln_mxl0 = .FALSE. ! mixing length scale surface value as function of wind stress or not 70 70 LOGICAL :: ln_lc = .FALSE. ! Langmuir cells (LC) as a source term of TKE or not 71 INTEGER :: nn_itke = 50 ! number of restart iterative loops72 71 INTEGER :: nn_mxl = 2 ! type of mixing length (=0/1/2/3) 73 72 INTEGER :: nn_pdl = 1 ! Prandtl number or not (ratio avt/avm) (=0/1) 74 INTEGER :: nn_ave = 1 ! horizontal average or not on avt, avmu, avmv (=0/1)75 73 REAL(wp) :: rn_ediff = 0.1_wp ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) 76 74 REAL(wp) :: rn_ediss = 0.7_wp ! coefficient of the Kolmogoroff dissipation 77 75 REAL(wp) :: rn_ebb = 3.75_wp ! coefficient of the surface input of tke 78 REAL(wp) :: rn_efave = 1._wp ! coefficient for ave : ave=rn_efave*avm79 76 REAL(wp) :: rn_emin = 0.7071e-6_wp ! minimum value of tke (m2/s2) 80 77 REAL(wp) :: rn_emin0 = 1.e-4_wp ! surface minimum value of tke (m2/s2) 81 REAL(wp) :: rn_ cri = 2._wp / 9._wp ! critic Richardson number78 REAL(wp) :: rn_bshear= 1.e-20_wp ! background shear (>0) (Not used in old TKE) 82 79 INTEGER :: nn_etau = 0 ! type of depth penetration of surface tke (=0/1/2) 83 80 INTEGER :: nn_htau = 0 ! type of tke profile of penetration (=0/1) … … 85 82 REAL(wp) :: rn_lmin = 0.1_wp ! interior min value of mixing length 86 83 REAL(wp) :: rn_efr = 1.0_wp ! fraction of TKE surface value which penetrates in the ocean 84 REAL(wp) :: rn_addhft= 0.0_wp ! add offset applied to HF tau (Not used in old TKE) 85 REAL(wp) :: rn_sclhft= 1.0_wp ! scale factor applied to HF tau (Not used in old TKE) 87 86 REAL(wp) :: rn_lc = 0.15_wp ! coef to compute vertical velocity of Langmuir cells 87 88 ! !! ** old namelist value: now hard coded ** 89 INTEGER :: nn_ave = 1 ! horizontal average or not on avt, avmu, avmv (=0/1) 90 REAL(wp) :: rn_efave = 1._wp ! coefficient for ave : ave=rn_efave*avm 91 REAL(wp) :: rn_cri = 2._wp / 9._wp ! critic Richardson number 88 92 89 93 !! * Substitutions … … 686 690 CALL lbc_lnk( avt, 'W', 1. ) ! Lateral boundary conditions on avt (sign unchanged) 687 691 688 IF( lrst_oce ) CALL tke_ rst( kt, 'WRITE' ) ! write en in restart file692 IF( lrst_oce ) CALL tke_old_rst( kt, 'WRITE' ) ! write en in restart file 689 693 690 694 IF(ln_ctl) THEN … … 721 725 # endif 722 726 !! 723 NAMELIST/namzdf_tke/ ln_rstke, rn_ediff, rn_ediss, rn_ebb , rn_efave, rn_emin, & 724 & rn_emin0, rn_cri , nn_itke , nn_mxl , nn_pdl , nn_ave , & 725 & ln_mxl0 , rn_lmin , rn_lmin0, nn_etau, & 726 & nn_htau , rn_efr , ln_lc , rn_lc 727 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & 728 & rn_emin0, rn_bshear, nn_mxl , ln_mxl0 , & 729 & rn_lmin , rn_lmin0 , nn_pdl , nn_etau , & 730 & nn_htau , rn_efr , rn_addhft, rn_sclhft, & 731 & ln_lc , rn_lc 727 732 !!---------------------------------------------------------------------- 728 733 … … 747 752 WRITE(numout,*) '~~~~~~~~~~~~' 748 753 WRITE(numout,*) ' Namelist namzdf_tke : set tke mixing parameters' 749 WRITE(numout,*) ' restart with tke from no tke ln_rstke = ', ln_rstke750 754 WRITE(numout,*) ' coef. to compute avt rn_ediff = ', rn_ediff 751 755 WRITE(numout,*) ' Kolmogoroff dissipation coef. rn_ediss = ', rn_ediss 752 756 WRITE(numout,*) ' tke surface input coef. rn_ebb = ', rn_ebb 753 WRITE(numout,*) ' tke diffusion coef. rn_efave = ', rn_efave754 757 WRITE(numout,*) ' minimum value of tke rn_emin = ', rn_emin 755 758 WRITE(numout,*) ' surface minimum value of tke rn_emin0 = ', rn_emin0 756 WRITE(numout,*) ' number of restart iter loops nn_itke = ', nn_itke757 759 WRITE(numout,*) ' mixing length type nn_mxl = ', nn_mxl 758 760 WRITE(numout,*) ' prandl number flag nn_pdl = ', nn_pdl … … 852 854 ! read or initialize turbulent kinetic energy ( en ) 853 855 ! ------------------------------------------------- 854 CALL tke_ rst( nit000, 'READ' )856 CALL tke_old_rst( nit000, 'READ' ) 855 857 ! 856 858 END SUBROUTINE zdf_tke_init 857 859 858 860 859 SUBROUTINE tke_ rst( kt, cdrw )861 SUBROUTINE tke_old_rst( kt, cdrw ) 860 862 !!--------------------------------------------------------------------- 861 863 !! *** ROUTINE ts_rst *** … … 875 877 IF( TRIM(cdrw) == 'READ' ) THEN 876 878 IF( ln_rstart ) THEN 877 IF( iom_varid( numror, 'en', ldstop = .FALSE. ) > 0 .AND. .NOT.(ln_rstke)) THEN879 IF( iom_varid( numror, 'en', ldstop = .FALSE. ) > 0 ) THEN 878 880 CALL iom_get( numror, jpdom_autoglo, 'en', en ) 879 881 ELSE 880 IF( lwp .AND. iom_varid( numror, 'en', ldstop = .FALSE. ) > 0 ) & 881 & WRITE(numout,*) ' ===>>>> : previous run without tke scheme' 882 IF( lwp .AND. ln_rstke ) WRITE(numout,*) ' ===>>>> : We do not use en from the restart file' 882 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without tke scheme' 883 883 IF( lwp ) WRITE(numout,*) ' ===>>>> : en is set by iterative loop' 884 884 en (:,:,:) = rn_emin * tmask(:,:,:) 885 DO jit = 2, nn_itke +1885 DO jit = 2, 51 886 886 CALL zdf_tke_old( jit ) 887 887 END DO … … 894 894 ENDIF 895 895 ! 896 END SUBROUTINE tke_ rst896 END SUBROUTINE tke_old_rst 897 897 898 898 #else -
branches/TAM_V3_2_2/NEMO/OPA_SRC/lib_mpp.F90
r1718 r2578 112 112 INTEGER :: mppsize ! number of process 113 113 INTEGER :: mpprank ! process number [ 0 - size-1 ] 114 INTEGER :: mpi_comm_opa ! opa local communicator 114 !$AGRIF_DO_NOT_TREAT 115 INTEGER, PUBLIC :: mpi_comm_opa ! opa local communicator 116 !$AGRIF_END_DO_NOT_TREAT 115 117 116 118 ! variables used in case of sea-ice … … 129 131 130 132 ! North fold condition in mpp_mpi with jpni > 1 131 INTEGER :: ngrp_world ! group ID for the world processors132 INTEGER :: ngrp_opa ! group ID for the opa processors133 INTEGER :: ngrp_north ! group ID for the northern processors (to be fold)134 INTEGER :: ncomm_north ! communicator made by the processors belonging to ngrp_north135 INTEGER :: ndim_rank_north ! number of 'sea' processor in the northern line (can be /= jpni !)136 INTEGER :: njmppmax ! value of njmpp for the processors of the northern line137 INTEGER :: north_root ! number (in the comm_opa) of proc 0 in the northern comm138 INTEGER, DIMENSION(:), ALLOCATABLE :: nrank_north ! dimension ndim_rank_north133 INTEGER, PUBLIC :: ngrp_world ! group ID for the world processors 134 INTEGER, PUBLIC :: ngrp_opa ! group ID for the opa processors 135 INTEGER, PUBLIC :: ngrp_north ! group ID for the northern processors (to be fold) 136 INTEGER, PUBLIC :: ncomm_north ! communicator made by the processors belonging to ngrp_north 137 INTEGER, PUBLIC :: ndim_rank_north ! number of 'sea' processor in the northern line (can be /= jpni !) 138 INTEGER, PUBLIC :: njmppmax ! value of njmpp for the processors of the northern line 139 INTEGER, PUBLIC :: north_root ! number (in the comm_opa) of proc 0 in the northern comm 140 INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: nrank_north ! dimension ndim_rank_north 139 141 140 142 ! Type of send : standard, buffered, immediate 141 143 CHARACTER(len=1) :: cn_mpi_send = 'S' ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 142 LOGICAL 144 LOGICAL, PUBLIC :: l_isend = .FALSE. ! isend use indicator (T if cn_mpi_send='I') 143 145 INTEGER :: nn_buffer = 0 ! size of the buffer in case of mpi_bsend 144 146 … … 191 193 WRITE(ldtxt(6),*) ' size in bytes of exported buffer nn_buffer = ', nn_buffer 192 194 193 #if defined key_agrif 194 IF( Agrif_Root() ) THEN 195 #endif 196 !!bug RB : should be clean to use Agrif in coupled mode 197 #if ! defined key_agrif 198 CALL mpi_initialized ( mpi_was_called, code ) 199 IF( code /= MPI_SUCCESS ) THEN 200 WRITE(*, cform_err) 201 WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 202 CALL mpi_abort( mpi_comm_world, code, ierr ) 203 ENDIF 204 205 IF( PRESENT(localComm) .and. mpi_was_called ) THEN 206 mpi_comm_opa = localComm 207 SELECT CASE ( cn_mpi_send ) 208 CASE ( 'S' ) ! Standard mpi send (blocking) 209 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 210 CASE ( 'B' ) ! Buffer mpi send (blocking) 211 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 212 CALL mpi_init_opa( ierr ) 213 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 214 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 215 l_isend = .TRUE. 216 CASE DEFAULT 217 WRITE(ldtxt(7),cform_err) 218 WRITE(ldtxt(8),*) ' bad value for cn_mpi_send = ', cn_mpi_send 219 nstop = nstop + 1 220 END SELECT 221 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 222 WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 223 WRITE(ldtxt(8),*) ' without calling MPI_Init before ! ' 224 nstop = nstop + 1 225 ELSE 226 #endif 227 SELECT CASE ( cn_mpi_send ) 228 CASE ( 'S' ) ! Standard mpi send (blocking) 229 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 230 CALL mpi_init( ierr ) 231 CASE ( 'B' ) ! Buffer mpi send (blocking) 232 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 233 CALL mpi_init_opa( ierr ) 234 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 235 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 236 l_isend = .TRUE. 237 CALL mpi_init( ierr ) 238 CASE DEFAULT 239 WRITE(ldtxt(7),cform_err) 240 WRITE(ldtxt(8),*) ' bad value for cn_mpi_send = ', cn_mpi_send 241 nstop = nstop + 1 242 END SELECT 243 244 #if ! defined key_agrif 245 CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 246 IF( code /= MPI_SUCCESS ) THEN 247 WRITE(*, cform_err) 248 WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 249 CALL mpi_abort( mpi_comm_world, code, ierr ) 250 ENDIF 251 ! 252 ENDIF 253 #endif 254 #if defined key_agrif 255 ELSE 195 CALL mpi_initialized ( mpi_was_called, code ) 196 IF( code /= MPI_SUCCESS ) THEN 197 WRITE(*, cform_err) 198 WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 199 CALL mpi_abort( mpi_comm_world, code, ierr ) 200 ENDIF 201 202 IF( PRESENT(localComm) .and. mpi_was_called ) THEN 203 ! 256 204 SELECT CASE ( cn_mpi_send ) 257 205 CASE ( 'S' ) ! Standard mpi send (blocking) … … 259 207 CASE ( 'B' ) ! Buffer mpi send (blocking) 260 208 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 209 CALL mpi_init_opa( ierr ) 261 210 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 262 211 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' … … 267 216 nstop = nstop + 1 268 217 END SELECT 218 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 219 WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 220 WRITE(ldtxt(8),*) ' without calling MPI_Init before ! ' 221 nstop = nstop + 1 222 ELSE 223 SELECT CASE ( cn_mpi_send ) 224 CASE ( 'S' ) ! Standard mpi send (blocking) 225 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 226 CALL mpi_init( ierr ) 227 CASE ( 'B' ) ! Buffer mpi send (blocking) 228 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 229 CALL mpi_init_opa( ierr ) 230 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 231 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 232 l_isend = .TRUE. 233 CALL mpi_init( ierr ) 234 CASE DEFAULT 235 WRITE(ldtxt(7),cform_err) 236 WRITE(ldtxt(8),*) ' bad value for cn_mpi_send = ', cn_mpi_send 237 nstop = nstop + 1 238 END SELECT 239 ! 269 240 ENDIF 270 241 271 mpi_comm_opa = mpi_comm_world 272 #endif 242 IF( PRESENT(localComm) ) THEN 243 IF( Agrif_Root() ) THEN 244 mpi_comm_opa = localComm 245 ENDIF 246 ELSE 247 CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 248 IF( code /= MPI_SUCCESS ) THEN 249 WRITE(*, cform_err) 250 WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 251 CALL mpi_abort( mpi_comm_world, code, ierr ) 252 ENDIF 253 ENDIF 254 273 255 CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 274 256 CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) … … 926 908 SELECT CASE ( jpni ) 927 909 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj ) 928 910 CASE DEFAULT ; CALL mpp_lbc_north_e( pt2d , cd_type, psgn ) 929 911 END SELECT 930 912 ! … … 2067 2049 ijpj = 4 2068 2050 ijpjm1 = 3 2051 ztab(:,:,:) = 0.e0 2069 2052 ! 2070 2053 DO jj = nlcj - ijpj +1, nlcj ! put in znorthloc the last 4 jlines of pt3d … … 2132 2115 ijpj = 4 2133 2116 ijpjm1 = 3 2117 ztab(:,:) = 0.e0 2134 2118 ! 2135 2119 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc the last 4 jlines of pt2d … … 2197 2181 ! 2198 2182 ijpj=4 2183 ztab(:,:) = 0.e0 2199 2184 2200 2185 ij=0 -
branches/TAM_V3_2_2/NEMO/OPA_SRC/opa.F90
r1725 r2578 54 54 USE trdmod ! momentum/tracers trends (trd_mod_init routine) 55 55 USE diaptr ! poleward transports (dia_ptr_init routine) 56 USE tamtrj ! writing out state trajectory 57 56 58 USE step ! OPA time-stepping (stp routine) 57 59 #if defined key_oasis3 … … 156 158 CALL opa_closefile 157 159 #if defined key_oasis3 || defined key_oasis4 158 CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS 160 IF( Agrif_Root() ) THEN 161 CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS 162 ENDIF 159 163 #else 160 164 IF( lk_mpp ) CALL mppstop ! end mpp communications … … 190 194 ! !--------------------------------------------! 191 195 #if defined key_iomput 196 IF( Agrif_Root() ) THEN 192 197 # if defined key_oasis3 || defined key_oasis4 193 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 194 CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it) 195 # else 196 CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server 198 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 197 199 # endif 200 CALL init_ioclient( ilocal_comm ) ! exchange io_server nemo local communicator with the io_server 201 ENDIF 198 202 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection 199 200 203 #else 201 204 # if defined key_oasis3 || defined key_oasis4 202 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 205 IF( Agrif_Root() ) THEN 206 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 207 ENDIF 203 208 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt) 204 209 # else … … 272 277 CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends 273 278 ! 279 CALL tam_trj_init 280 ! 274 281 END SUBROUTINE opa_init 275 282 … … 287 294 NAMELIST/namdyn_hpg/ ln_hpg_zco , ln_hpg_zps , ln_hpg_sco, ln_hpg_hel, & 288 295 & ln_hpg_wdj , ln_hpg_djc , ln_hpg_rot, rn_gamma , & 289 & ln_dynhpg_imp , nn_dynhpg_rst296 & ln_dynhpg_imp 290 297 !!---------------------------------------------------------------------- 291 298 -
branches/TAM_V3_2_2/NEMO/OPA_SRC/step.F90
r1756 r2578 19 19 !! - ! 2006-01 (L. Debreu, C. Mazauric) Agrif implementation 20 20 !! - ! 2006-07 (S. Masson) restart using iom 21 !! - ! 2008-06 (A. Vidard) TAM interface 21 22 !! 3.2 ! 2009-02 (G. Madec, R. Benshila) reintroduicing z*-coordinate 22 23 !! - ! 2009-06 (S. Masson, G. Madec) TKE restart compatible with key_cpl … … 112 113 USE flo_oce ! floats variables 113 114 USE floats ! floats computation (flo_stp routine) 115 USE tamtrj ! writing out state trajectory 114 116 115 117 USE stpctl ! time stepping control (stp_ctl routine) … … 160 162 !! -8- Outputs and diagnostics 161 163 !!---------------------------------------------------------------------- 164 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zta_tmp, zsa_tmp 162 165 INTEGER :: jk ! dummy loop indice 163 166 INTEGER :: indic ! error indicator if < 0 … … 168 171 ! IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 169 172 ! IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 173 # if defined key_iomput 174 IF( Agrif_Nbstepint() == 0) CALL iom_swap 175 # endif 170 176 #endif 171 177 indic = 1 ! reset to no error condition … … 175 181 CALL iom_setkt( kstp ) ! say to iom that we are at time step kstp 176 182 177 CALL rst_opn( kstp ) ! Open the restart file178 179 183 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 180 184 ! Update data, open boundaries, surface boundary condition (including sea-ice) … … 261 265 ta(:,:,:) = 0.e0 ! set tracer trends to zero 262 266 sa(:,:,:) = 0.e0 267 268 ! Saving non-linear trajectory at restart state 269 ! May not be exact for sbc and zdf parameters 270 IF( ( ln_trjwri ) .AND. ( kstp == nit000 ) ) CALL tam_trj_wri( kstp - 1 ) 263 271 264 272 CALL tra_sbc ( kstp ) ! surface boundary condition … … 292 300 IF( ln_zdfnpc ) CALL tra_npc ( kstp ) ! update after fields by non-penetrative convection 293 301 CALL tra_nxt ( kstp ) ! tracer fields at next time step 294 ENDIF 302 ENDIF 303 304 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 305 ! saving ta and sa (temporary fix, please do not remove) 306 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 307 IF (ln_trjwri) THEN 308 ALLOCATE ( zta_tmp(jpi,jpj,jpk), & 309 & zsa_tmp(jpi,jpj,jpk) ) 310 zta_tmp(:,:,:) = ta(:,:,:) 311 zsa_tmp(:,:,:) = sa(:,:,:) 312 END IF 295 313 296 314 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 335 353 IF( lk_trdmld ) CALL trd_mld( kstp ) ! trends: Mixed-layer 336 354 IF( lk_trdvor ) CALL trd_vor( kstp ) ! trends: vorticity budget 337 ENDIF 355 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 356 ! restoring ta and sa (temporary fix, please do not remove) 357 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 358 IF (ln_trjwri) THEN 359 ta(:,:,:) = zta_tmp(:,:,:) 360 sa(:,:,:) = zsa_tmp(:,:,:) 361 DEALLOCATE ( zta_tmp, & 362 & zsa_tmp ) 363 END IF 364 365 366 ENDIF 367 368 IF( ln_trjwri ) CALL tam_trj_wri( kstp ) ! Output trajectory fields 338 369 339 370 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Note: See TracChangeset
for help on using the changeset viewer.