Changeset 3570 for branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO
- Timestamp:
- 2012-11-16T10:58:11+01:00 (12 years ago)
- Location:
- branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO
- Files:
-
- 29 edited
-
LIM_SRC_2/limdmp_2.F90 (modified) (6 diffs)
-
LIM_SRC_3/limistate.F90 (modified) (1 diff)
-
LIM_SRC_3/limthd_dif.F90 (modified) (3 diffs)
-
LIM_SRC_3/limtrp.F90 (modified) (1 diff)
-
OFF_SRC/domain.F90 (modified) (1 diff)
-
OPA_SRC/BDY/bdyice_lim2.F90 (modified) (1 diff)
-
OPA_SRC/DIA/diadct.F90 (modified) (5 diffs)
-
OPA_SRC/DIA/diaptr.F90 (modified) (2 diffs)
-
OPA_SRC/DIA/diawri.F90 (modified) (2 diffs)
-
OPA_SRC/DOM/closea.F90 (modified) (9 diffs)
-
OPA_SRC/DOM/dom_oce.F90 (modified) (1 diff)
-
OPA_SRC/DOM/domain.F90 (modified) (1 diff)
-
OPA_SRC/DOM/domzgr.F90 (modified) (3 diffs)
-
OPA_SRC/DYN/dynhpg.F90 (modified) (16 diffs)
-
OPA_SRC/IOM/prtctl.F90 (modified) (1 diff)
-
OPA_SRC/LBC/lib_mpp.F90 (modified) (10 diffs)
-
OPA_SRC/SBC/sbccpl.F90 (modified) (4 diffs)
-
OPA_SRC/SBC/sbcmod.F90 (modified) (1 diff)
-
OPA_SRC/SBC/sbcrnf.F90 (modified) (1 diff)
-
OPA_SRC/TRA/traldf_iso_grif.F90 (modified) (1 diff)
-
OPA_SRC/TRD/trdtra.F90 (modified) (1 diff)
-
OPA_SRC/ZDF/zdfddm.F90 (modified) (1 diff)
-
OPA_SRC/ZDF/zdftke.F90 (modified) (4 diffs)
-
OPA_SRC/lib_fortran.F90 (modified) (4 diffs)
-
OPA_SRC/nemogcm.F90 (modified) (1 diff)
-
OPA_SRC/timing.F90 (modified) (14 diffs)
-
TOP_SRC/PISCES/p4zsink.F90 (modified) (1 diff)
-
TOP_SRC/TRP/trczdf.F90 (modified) (1 diff)
-
TOP_SRC/TRP/trdmod_trc.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90
r2715 r3570 11 11 !! 'key_lim2' LIM 2.0 sea-ice model 12 12 !!---------------------------------------------------------------------- 13 !! lim_dmp_2 13 !! lim_dmp_2 : ice model damping 14 14 !!---------------------------------------------------------------------- 15 USE ice_2 15 USE ice_2 ! ice variables 16 16 USE sbc_oce, ONLY : nn_fsbc ! for fldread 17 USE dom_oce 18 USE fldread 19 USE in_out_manager 20 USE lib_mpp 17 USE dom_oce ! for mi0; mi1 etc ... 18 USE fldread ! read input fields 19 USE in_out_manager ! I/O manager 20 USE lib_mpp ! MPP library 21 21 22 22 IMPLICIT NONE … … 25 25 PUBLIC lim_dmp_2 ! called by sbc_ice_lim2 26 26 27 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: resto_ice ! restoring coeff. on ICE [s-1] 28 29 INTEGER, PARAMETER :: jp_hicif = 1 , jp_frld = 2 30 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_icedmp ! structure of ice damping input 27 INTEGER , PARAMETER :: jp_hicif = 1 , jp_frld = 2 28 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) :: resto_ice ! restoring coeff. on ICE [s-1] 29 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_icedmp ! structure of ice damping input 31 30 32 31 !! * Substitution … … 43 42 !! *** ROUTINE lim_dmp_2 *** 44 43 !! 45 !! ** purpose : ice model damping : restoring ice thickness and fraction leads44 !! ** purpose : restore ice thickness and lead fraction 46 45 !! 47 !! ** method : the key_tradmp must be used to compute resto(:,:,1) coef. 46 !! ** method : restore ice thickness and lead fraction using a restoring 47 !! coefficient defined by the user in lim_dmp_init 48 !! 49 !! ** Action : - update hicif and frld 50 !! 48 51 !!--------------------------------------------------------------------- 49 52 INTEGER, INTENT(in) :: kt ! ocean time-step … … 53 56 !!--------------------------------------------------------------------- 54 57 ! 55 IF (kt == nit000)THEN58 IF( kt == nit000 ) THEN 56 59 IF(lwp) WRITE(numout,*) 57 60 IF(lwp) WRITE(numout,*) 'lim_dmp_2 : Ice thickness and ice concentration restoring' … … 71 74 & hicif(:,:) - rdt_ice * resto_ice(:,:,1) * ( hicif(:,:) - sf_icedmp(jp_hicif)%fnow(:,:,1) ) ) 72 75 !CDIR COLLAPSE 73 hicif(:,:) = MAX( 0._wp, MIN( 1._wp, & ! 0<= frld<=1 values which blow the run up76 frld (:,:) = MAX( 0._wp, MIN( 1._wp, & ! 0<= frld<=1 values which blow the run up 74 77 & frld (:,:) - rdt_ice * resto_ice(:,:,1) * ( frld (:,:) - sf_icedmp(jp_frld )%fnow(:,:,1) ) ) ) 75 78 ! … … 83 86 !! *** ROUTINE lim_dmp_init *** 84 87 !! 85 !! ** Purpose : Initialization for the ice thickness and concentration 86 !! restoring 87 !! restoring will be used. It is used to mimic ice open 88 !! boundaries. 88 !! ** Purpose : set the coefficient for the ice thickness and lead fraction restoring 89 89 !! 90 !! ** Method : ????? 90 !! ** Method : restoring is used to mimic ice open boundaries. 91 !! the restoring coef. (a 2D array) has to be defined by the user. 92 !! here is given as an example a restoring along north and south boundaries 91 93 !! 92 94 !! ** Action : define resto_ice(:,:,1) -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r3294 r3570 460 460 ! 4) Moments for advection 461 461 !-------------------------------------------------------------------- 462 463 sxopw (:,:) = 0.e0 464 syopw (:,:) = 0.e0 465 sxxopw(:,:) = 0.e0 466 syyopw(:,:) = 0.e0 467 sxyopw(:,:) = 0.e0 462 468 463 469 sxice (:,:,:) = 0.e0 ; sxsn (:,:,:) = 0.e0 ; sxa (:,:,:) = 0.e0 -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r3294 r3570 102 102 INTEGER :: nconv ! number of iterations in iterative procedure 103 103 INTEGER :: minnumeqmin, maxnumeqmax 104 105 INTEGER , POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation 106 INTEGER , POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation 107 INTEGER , POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow 108 109 !! * New local variables 110 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i !Ice thermal conductivity 111 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i !Radiation transmitted through the ice 112 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i !Radiation absorbed in the ice 113 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i !Kappa factor in the ice 114 115 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s !Radiation transmited through the snow 116 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s !Radiation absorbed in the snow 117 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s !Kappa factor in the snow 118 119 REAL(wp), POINTER, DIMENSION(:,:) :: ztiold !Old temperature in the ice 120 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i !Eta factor in the ice 121 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp !Temporary temperature in the ice to check the convergence 122 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i !Ice specific heat 123 REAL(wp), POINTER, DIMENSION(:,:) :: z_i !Vertical cotes of the layers in the ice 124 125 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s !Eta factor in the snow 126 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp !Temporary temperature in the snow to check the convergence 127 REAL(wp), POINTER, DIMENSION(:,:) :: ztsold !Temporary temperature in the snow 128 REAL(wp), POINTER, DIMENSION(:,:) :: z_s !Vertical cotes of the layers in the snow 129 130 REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! Independent term 131 REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! temporary independent term 132 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis 133 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms 134 135 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! ice melting point 136 REAL(wp), POINTER, DIMENSION(:) :: ztsuold ! old surface temperature (before the iterative procedure ) 137 REAL(wp), POINTER, DIMENSION(:) :: ztsuoldit ! surface temperature at previous iteration 138 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 139 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 140 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface 141 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function 142 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function 143 104 INTEGER, DIMENSION(kiut) :: numeqmin ! reference number of top equation 105 INTEGER, DIMENSION(kiut) :: numeqmax ! reference number of bottom equation 106 INTEGER, DIMENSION(kiut) :: isnow ! switch for presence (1) or absence (0) of snow 144 107 REAL(wp) :: zeps = 1.e-10_wp ! 145 108 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system … … 150 113 REAL(wp) :: zkimin = 0.10_wp ! minimum ice thermal conductivity 151 114 REAL(wp) :: zht_smin = 1.e-4_wp ! minimum snow depth 152 153 115 REAL(wp) :: ztmelt_i ! ice melting temperature 154 116 REAL(wp) :: zerritmax ! current maximal error on temperature 155 REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature 156 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4) 157 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice 158 REAL(wp), POINTER, DIMENSION(:) :: zihic, zhsu 117 REAL(wp), DIMENSION(kiut) :: ztfs ! ice melting point 118 REAL(wp), DIMENSION(kiut) :: ztsuold ! old surface temperature (before the iterative procedure ) 119 REAL(wp), DIMENSION(kiut) :: ztsuoldit ! surface temperature at previous iteration 120 REAL(wp), DIMENSION(kiut) :: zh_i ! ice layer thickness 121 REAL(wp), DIMENSION(kiut) :: zh_s ! snow layer thickness 122 REAL(wp), DIMENSION(kiut) :: zfsw ! solar radiation absorbed at the surface 123 REAL(wp), DIMENSION(kiut) :: zf ! surface flux function 124 REAL(wp), DIMENSION(kiut) :: dzf ! derivative of the surface flux function 125 REAL(wp), DIMENSION(kiut) :: zerrit ! current error on temperature 126 REAL(wp), DIMENSION(kiut) :: zdifcase ! case of the equation resolution (1->4) 127 REAL(wp), DIMENSION(kiut) :: zftrice ! solar radiation transmitted through the ice 128 REAL(wp), DIMENSION(kiut) :: zihic, zhsu 129 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztcond_i ! Ice thermal conductivity 130 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zradtr_i ! Radiation transmitted through the ice 131 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zradab_i ! Radiation absorbed in the ice 132 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zkappa_i ! Kappa factor in the ice 133 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztiold ! Old temperature in the ice 134 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zeta_i ! Eta factor in the ice 135 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztitemp ! Temporary temperature in the ice to check the convergence 136 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zspeche_i ! Ice specific heat 137 REAL(wp), DIMENSION(kiut,0:nlay_i) :: z_i ! Vertical cotes of the layers in the ice 138 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zradtr_s ! Radiation transmited through the snow 139 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zradab_s ! Radiation absorbed in the snow 140 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zkappa_s ! Kappa factor in the snow 141 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zeta_s ! Eta factor in the snow 142 REAL(wp), DIMENSION(kiut,0:nlay_s) :: ztstemp ! Temporary temperature in the snow to check the convergence 143 REAL(wp), DIMENSION(kiut,0:nlay_s) :: ztsold ! Temporary temperature in the snow 144 REAL(wp), DIMENSION(kiut,0:nlay_s) :: z_s ! Vertical cotes of the layers in the snow 145 REAL(wp), DIMENSION(kiut,jkmax+2) :: zindterm ! Independent term 146 REAL(wp), DIMENSION(kiut,jkmax+2) :: zindtbis ! temporary independent term 147 REAL(wp), DIMENSION(kiut,jkmax+2) :: zdiagbis 148 REAL(wp), DIMENSION(kiut,jkmax+2,3) :: ztrid ! tridiagonal system terms 159 149 !!------------------------------------------------------------------ 160 ! 161 CALL wrk_alloc( kiut, numeqmin, numeqmax, isnow ) ! integer 162 CALL wrk_alloc( kiut,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, zspeche_i, z_i, kjstart=0 ) 163 CALL wrk_alloc( kiut,nlay_s+1, zradtr_s, zradab_s, zkappa_s, zeta_s, ztstemp, ztsold, z_s, kjstart=0 ) 164 CALL wrk_alloc( kiut,jkmax+2, zindterm, zindtbis, zdiagbis ) 165 CALL wrk_alloc( kiut,jkmax+2,3, ztrid ) 166 CALL wrk_alloc( kiut, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw, zf, dzf ) 167 CALL wrk_alloc( kiut, zerrit, zdifcase, zftrice, zihic, zhsu ) 168 150 151 ! 169 152 !------------------------------------------------------------------------------! 170 153 ! 1) Initialization ! … … 772 755 ENDIF 773 756 ! 774 CALL wrk_dealloc( kiut, numeqmin, numeqmax, isnow ) ! integer775 CALL wrk_dealloc( kiut,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, zspeche_i, z_i, kjstart=0 )776 CALL wrk_dealloc( kiut,nlay_s+1, zradtr_s, zradab_s, zkappa_s, zeta_s, ztstemp, ztsold, z_s, kjstart=0 )777 CALL wrk_dealloc( kiut,jkmax+2, zindterm, zindtbis, zdiagbis )778 CALL wrk_dealloc( kiut,jkmax+2,3, ztrid )779 CALL wrk_dealloc( kiut, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw, zf, dzf )780 CALL wrk_dealloc( kiut, zerrit, zdifcase, zftrice, zihic, zhsu )781 782 757 END SUBROUTINE lim_thd_dif 783 758 -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r3294 r3570 174 174 ELSE 175 175 DO jk = 1, initad 176 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area176 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 177 177 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 178 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0ow (:,:), sxopw(:,:), &178 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), & 179 179 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 180 180 DO jl = 1, jpl 181 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---181 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 182 182 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 183 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &183 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 184 184 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 185 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---185 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 186 186 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 187 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &187 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 188 188 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 189 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---189 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 190 190 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 191 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &191 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 192 192 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 193 193 194 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---194 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 195 195 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 196 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &196 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 197 197 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 198 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---198 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 199 199 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 200 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0a (:,:,jl), sxa (:,:,jl), &200 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 201 201 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 202 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---202 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 203 203 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 204 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &204 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 205 205 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 206 206 DO layer = 1, nlay_i !--- ice heat contents --- 207 CALL lim_adv_y( zusnit, v_ice, r zero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &207 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 208 208 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 209 209 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 210 CALL lim_adv_x( zusnit, u_ice, r one, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &210 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 211 211 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 212 212 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OFF_SRC/domain.F90
r2574 r3570 205 205 rdtmax = rn_rdtmin 206 206 rdth = rn_rdth 207 nclosea = nn_closea208 207 209 208 REWIND( numnam ) ! Namelist cross land advection -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90
r3294 r3570 53 53 CYCLE 54 54 CASE(jp_frs) 55 CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_ idx(ib_bdy) )55 CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy) ) 56 56 CASE DEFAULT 57 57 CALL ctl_stop( 'bdy_ice_lim_2 : unrecognised option for open boundaries for ice fields' ) -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r3294 r3570 38 38 USE dianam ! build name of file 39 39 USE lib_mpp ! distributed memory computing library 40 #if defined key_lim2 || defined key_lim3 41 USE ice 40 #if defined key_lim2 41 USE ice_2 42 #endif 43 #if defined key_lim3 44 USE ice_3 42 45 #endif 43 46 USE domvvl … … 362 365 WRITE(numout,*)" List of points in global domain:" 363 366 DO jpt=1,iptglo 364 WRITE(numout,*)' # I J ',jpt,coordtemp(jpt) 367 WRITE(numout,*)' # I J ',jpt,coordtemp(jpt),directemp(jpt) 365 368 ENDDO 366 369 ENDIF … … 403 406 404 407 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 405 WRITE(narea+200,*)'avant secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc406 408 DO jpt = 1,iptloc 407 409 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 408 410 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 409 WRITE(narea+200,*)'avant # I J : ',iiglo,ijglo410 411 ENDDO 411 412 ENDIF … … 421 422 ENDIF 422 423 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 423 WRITE(narea+200,*)'apres secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc424 424 DO jpt = 1,secs(jsec)%nb_point 425 425 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 426 426 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 427 WRITE(narea+200,*)'apres # I J : ',iiglo,ijglo428 427 ENDDO 429 428 ENDIF … … 626 625 ELSE ; isgnv = 1 627 626 ENDIF 628 629 IF( ld_debug )write(numout,*)"isgnu isgnv ",isgnu,isgnv 627 IF( sec%slopeSection .GE. 9999. ) isgnv = 1 628 629 IF( ld_debug )write(numout,*)"sec%slopeSection isgnu isgnv ",sec%slopeSection,isgnu,isgnv 630 630 631 631 !--------------------------------------! -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r3294 r3570 332 332 !!---------------------------------------------------------------------- 333 333 USE oce, vt => ua ! use ua as workspace 334 USE oce, vs => ua ! use ua as workspace334 USE oce, vs => va ! use va as workspace 335 335 IMPLICIT none 336 336 !! … … 378 378 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 379 379 #endif 380 vt( :,jj,jk) = zv * tsn(:,jj,jk,jp_tem)381 vs( :,jj,jk) = zv * tsn(:,jj,jk,jp_sal)380 vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem) 381 vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal) 382 382 END DO 383 383 END DO -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r3294 r3570 171 171 z3d(:,:,jpk) = 0.e0 172 172 DO jk = 1, jpkm1 173 z3d(:,:,jk) = rau0 * un(:,:,jk) * e 1u(:,:) * fse3u(:,:,jk)173 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 174 174 END DO 175 175 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction … … 186 186 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction 187 187 DO jk = 1, jpkm1 188 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e 2v(:,:) * fse3v(:,:,jk)188 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 189 189 END DO 190 190 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r2715 r3570 7 7 !! 8.5 ! 02-06 (E. Durand, G. Madec) F90 8 8 !! 9.0 ! 06-07 (G. Madec) add clo_rnf, clo_ups, clo_bat 9 !! NEMO 3.4 ! 03-12 (P.G. Fogli) sbc_clo bug fix & mpp reproducibility 9 10 !!---------------------------------------------------------------------- 10 11 … … 20 21 USE in_out_manager ! I/O manager 21 22 USE sbc_oce ! ocean surface boundary conditions 22 USE lib_mpp ! distributed memory computing library 23 USE lbclnk ! ??? 23 USE lib_fortran, ONLY: glob_sum, DDPDD 24 USE lbclnk ! lateral boundary condition - MPP exchanges 25 USE lib_mpp ! MPP library 26 USE timing 24 27 25 28 IMPLICIT NONE … … 85 88 SELECT CASE ( jp_cfg ) 86 89 ! ! ======================= 90 CASE ( 1 ) ! ORCA_R1 configuration 91 ! ! ======================= 92 ncsnr(1) = 1 ; ncstt(1) = 0 ! Caspian Sea 93 ncsi1(1) = 332 ; ncsj1(1) = 203 94 ncsi2(1) = 344 ; ncsj2(1) = 235 95 ncsir(1,1) = 1 ; ncsjr(1,1) = 1 96 ! 97 ! ! ======================= 87 98 CASE ( 2 ) ! ORCA_R2 configuration 88 99 ! ! ======================= … … 177 188 INTEGER, INTENT(in) :: kt ! ocean model time step 178 189 ! 179 INTEGER :: ji, jj, jc, jn ! dummy loop indices 180 REAL(wp) :: zze2 181 REAL(wp), DIMENSION (jpncs) :: zfwf 182 !!---------------------------------------------------------------------- 183 ! 190 INTEGER :: ji, jj, jc, jn ! dummy loop indices 191 REAL(wp), PARAMETER :: rsmall = 1.e-20_wp ! Closed sea correction epsilon 192 REAL(wp) :: zze2, ztmp, zcorr ! 193 COMPLEX(wp) :: ctmp 194 REAL(wp), DIMENSION(jpncs) :: zfwf ! 1D workspace 195 !!---------------------------------------------------------------------- 196 ! 197 IF( nn_timing == 1 ) CALL timing_start('sbc_clo') 184 198 ! !------------------! 185 199 IF( kt == nit000 ) THEN ! Initialisation ! … … 189 203 IF(lwp) WRITE(numout,*)'~~~~~~~' 190 204 191 ! Total surface of ocean 192 surf(jpncs+1) = SUM( e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 193 194 DO jc = 1, jpncs 195 surf(jc) =0.e0 196 DO jj = ncsj1(jc), ncsj2(jc) 197 DO ji = ncsi1(jc), ncsi2(jc) 198 surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) ! surface of closed seas 205 surf(:) = 0.e0_wp 206 ! 207 surf(jpncs+1) = glob_sum( e1e2t(:,:) ) ! surface of the global ocean 208 ! 209 ! ! surface of closed seas 210 IF( lk_mpp_rep ) THEN ! MPP reproductible calculation 211 DO jc = 1, jpncs 212 ctmp = CMPLX( 0.e0, 0.e0, wp ) 213 DO jj = ncsj1(jc), ncsj2(jc) 214 DO ji = ncsi1(jc), ncsi2(jc) 215 ztmp = e1e2t(ji,jj) * tmask_i(ji,jj) 216 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 217 END DO 199 218 END DO 200 END DO 201 END DO 202 IF( lk_mpp ) CALL mpp_sum ( surf, jpncs+1 ) ! mpp: sum over all the global domain 219 IF( lk_mpp ) CALL mpp_sum( ctmp ) 220 surf(jc) = REAL(ctmp,wp) 221 END DO 222 ELSE ! Standard calculation 223 DO jc = 1, jpncs 224 DO jj = ncsj1(jc), ncsj2(jc) 225 DO ji = ncsi1(jc), ncsi2(jc) 226 surf(jc) = surf(jc) + e1e2t(ji,jj) * tmask_i(ji,jj) ! surface of closed seas 227 END DO 228 END DO 229 END DO 230 IF( lk_mpp ) CALL mpp_sum ( surf, jpncs ) ! mpp: sum over all the global domain 231 ENDIF 203 232 204 233 IF(lwp) WRITE(numout,*)' Closed sea surfaces' … … 215 244 ! !--------------------! 216 245 ! ! update emp, emps ! 217 zfwf = 0.e0 !--------------------! 218 DO jc = 1, jpncs 219 DO jj = ncsj1(jc), ncsj2(jc) 220 DO ji = ncsi1(jc), ncsi2(jc) 221 zfwf(jc) = zfwf(jc) + e1t(ji,jj) * e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 222 END DO 223 END DO 224 END DO 225 IF( lk_mpp ) CALL mpp_sum ( zfwf(:) , jpncs ) ! mpp: sum over all the global domain 246 zfwf = 0.e0_wp !--------------------! 247 IF( lk_mpp_rep ) THEN ! MPP reproductible calculation 248 DO jc = 1, jpncs 249 ctmp = CMPLX( 0.e0, 0.e0, wp ) 250 DO jj = ncsj1(jc), ncsj2(jc) 251 DO ji = ncsi1(jc), ncsi2(jc) 252 ztmp = e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 253 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 254 END DO 255 END DO 256 IF( lk_mpp ) CALL mpp_sum( ctmp ) 257 zfwf(jc) = REAL(ctmp,wp) 258 END DO 259 ELSE ! Standard calculation 260 DO jc = 1, jpncs 261 DO jj = ncsj1(jc), ncsj2(jc) 262 DO ji = ncsi1(jc), ncsi2(jc) 263 zfwf(jc) = zfwf(jc) + e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 264 END DO 265 END DO 266 END DO 267 IF( lk_mpp ) CALL mpp_sum ( zfwf(:) , jpncs ) ! mpp: sum over all the global domain 268 ENDIF 226 269 227 270 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! Black Sea case for ORCA_R2 configuration 228 zze2 = ( zfwf(3) + zfwf(4) ) / 2.271 zze2 = ( zfwf(3) + zfwf(4) ) * 0.5_wp 229 272 zfwf(3) = zze2 230 273 zfwf(4) = zze2 231 274 ENDIF 232 275 276 zcorr = 0._wp 277 233 278 DO jc = 1, jpncs 234 279 ! 235 IF( ncstt(jc) == 0 ) THEN 236 ! water/evap excess is shared by all open ocean 237 emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 238 emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 239 ELSEIF( ncstt(jc) == 1 ) THEN 240 ! Excess water in open sea, at outflow location, excess evap shared 241 IF ( zfwf(jc) <= 0.e0 ) THEN 242 DO jn = 1, ncsnr(jc) 280 ! The following if avoids the redistribution of the round off 281 IF ( ABS(zfwf(jc) / surf(jpncs+1) ) > rsmall) THEN 282 ! 283 IF( ncstt(jc) == 0 ) THEN ! water/evap excess is shared by all open ocean 284 emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 285 emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 286 ! accumulate closed seas correction 287 zcorr = zcorr + zfwf(jc) / surf(jpncs+1) 288 ! 289 ELSEIF( ncstt(jc) == 1 ) THEN ! Excess water in open sea, at outflow location, excess evap shared 290 IF ( zfwf(jc) <= 0.e0_wp ) THEN 291 DO jn = 1, ncsnr(jc) 292 ji = mi0(ncsir(jc,jn)) 293 jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean 294 IF ( ji > 1 .AND. ji < jpi & 295 .AND. jj > 1 .AND. jj < jpj ) THEN 296 emp (ji,jj) = emp (ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) ) 297 emps(ji,jj) = emps(ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) ) 298 ENDIF 299 END DO 300 ELSE 301 emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 302 emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 303 ! accumulate closed seas correction 304 zcorr = zcorr + zfwf(jc) / surf(jpncs+1) 305 ENDIF 306 ELSEIF( ncstt(jc) == 2 ) THEN ! Excess e-p-r (either sign) goes to open ocean, at outflow location 307 DO jn = 1, ncsnr(jc) 243 308 ji = mi0(ncsir(jc,jn)) 244 309 jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean 245 IF ( ji > 1 .AND. ji < jpi & 246 .AND. jj > 1 .AND. jj < jpj ) THEN 247 emp (ji,jj) = emp (ji,jj) + zfwf(jc) / & 248 (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj)) 249 emps(ji,jj) = emps(ji,jj) + zfwf(jc) / & 250 (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj)) 251 END IF 252 END DO 253 ELSE 254 emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 255 emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 256 ENDIF 257 ELSEIF( ncstt(jc) == 2 ) THEN 258 ! Excess e-p+r (either sign) goes to open ocean, at outflow location 259 IF( ji > 1 .AND. ji < jpi & 260 .AND. jj > 1 .AND. jj < jpj ) THEN 261 DO jn = 1, ncsnr(jc) 262 ji = mi0(ncsir(jc,jn)) 263 jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean 264 emp (ji,jj) = emp (ji,jj) + zfwf(jc) & 265 / (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj) ) 266 emps(ji,jj) = emps(ji,jj) + zfwf(jc) & 267 / (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj) ) 268 END DO 310 IF( ji > 1 .AND. ji < jpi & 311 .AND. jj > 1 .AND. jj < jpj ) THEN 312 emp (ji,jj) = emp (ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) ) 313 emps(ji,jj) = emps(ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) ) 314 ENDIF 315 END DO 269 316 ENDIF 270 ENDIF271 !272 DO jj = ncsj1(jc), ncsj2(jc)273 DO ji = ncsi1(jc), ncsi2(jc)274 emp (ji,jj) = emp(ji,jj) - zfwf(jc) / surf(jc)275 emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc)276 END DO 277 END DO278 !317 ! 318 DO jj = ncsj1(jc), ncsj2(jc) 319 DO ji = ncsi1(jc), ncsi2(jc) 320 emp (ji,jj) = emp (ji,jj) - zfwf(jc) / surf(jc) 321 emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc) 322 END DO 323 END DO 324 ! 325 END IF 279 326 END DO 280 ! 281 CALL lbc_lnk( emp , 'T', 1. ) 282 CALL lbc_lnk( emps, 'T', 1. ) 327 328 IF ( ABS(zcorr) > rsmall ) THEN ! remove the global correction from the closed seas 329 DO jc = 1, jpncs ! only if it is large enough 330 DO jj = ncsj1(jc), ncsj2(jc) 331 DO ji = ncsi1(jc), ncsi2(jc) 332 emp (ji,jj) = emp (ji,jj) - zcorr 333 emps(ji,jj) = emps(ji,jj) - zcorr 334 END DO 335 END DO 336 END DO 337 ENDIF 338 ! 339 emp (:,:) = emp (:,:) * tmask(:,:,1) 340 emps(:,:) = emps(:,:) * tmask(:,:,1) 341 ! 342 CALL lbc_lnk( emp , 'T', 1._wp ) 343 CALL lbc_lnk( emps, 'T', 1._wp ) 344 ! 345 IF( nn_timing == 1 ) CALL timing_stop('sbc_clo') 283 346 ! 284 347 END SUBROUTINE sbc_clo 285 286 348 349 287 350 SUBROUTINE clo_rnf( p_rnfmsk ) 288 351 !!--------------------------------------------------------------------- … … 308 371 ii = mi0( ncsir(jc,jn) ) 309 372 ij = mj0( ncsjr(jc,jn) ) 310 p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0 )373 p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0_wp ) 311 374 END DO 312 375 ENDIF … … 336 399 DO jj = ncsj1(jc), ncsj2(jc) 337 400 DO ji = ncsi1(jc), ncsi2(jc) 338 p_upsmsk(ji,jj) = 0.5 401 p_upsmsk(ji,jj) = 0.5_wp ! mixed upstream/centered scheme over closed seas 339 402 END DO 340 403 END DO … … 374 437 !!====================================================================== 375 438 END MODULE closea 439 -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r3294 r3570 52 52 REAL(wp), PUBLIC :: rdtmax !: maximum time step on tracers 53 53 REAL(wp), PUBLIC :: rdth !: depth variation of tracer step 54 INTEGER , PUBLIC :: nclosea !: =0 suppress closed sea/lake from the ORCA domain or not (=1)55 54 56 55 ! !!! associated variables -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r3294 r3570 238 238 rdtmax = rn_rdtmin 239 239 rdth = rn_rdth 240 nclosea = nn_closea241 240 242 241 REWIND( numnam ) ! Namelist cross land advection -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r3294 r3570 422 422 CALL iom_close( inum ) 423 423 mbathy(:,:) = INT( bathy(:,:) ) 424 ! ! =====================424 ! 425 425 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 426 ! ! =====================426 ! 427 427 IF( nn_cla == 0 ) THEN 428 428 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open … … 454 454 CALL iom_get ( inum, jpdom_data, 'Bathymetry', bathy ) 455 455 CALL iom_close( inum ) 456 ! ! =====================456 ! 457 457 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 458 ! ! =====================458 ! 459 459 IF( nn_cla == 0 ) THEN 460 460 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open … … 489 489 ENDIF 490 490 ! 491 ! ! =========================== ! 492 IF( nclosea == 0 ) THEN ! NO closed seas or lakes ! 493 DO jl = 1, jpncs ! =========================== ! 494 DO jj = ncsj1(jl), ncsj2(jl) 495 DO ji = ncsi1(jl), ncsi2(jl) 496 mbathy(ji,jj) = 0 ! suppress closed seas and lakes from bathymetry 497 bathy (ji,jj) = 0._wp 498 END DO 499 END DO 500 END DO 501 ENDIF 502 ! 503 ! ! =========================== ! 504 ! ! set a minimum depth ! 505 ! ! =========================== ! 506 IF ( .not. ln_sco ) THEN 491 IF( nn_closea == 0 ) CALL clo_bat( bathy, mbathy ) !== NO closed seas or lakes ==! 492 ! 493 IF ( .not. ln_sco ) THEN !== set a minimum depth ==! 507 494 IF( rn_hmin < 0._wp ) THEN ; ik = - INT( rn_hmin ) ! from a nb of level 508 495 ELSE ; ik = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 ) ! from a depth -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r3294 r3570 678 678 REAL(wp) :: zrhdt1 679 679 REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 680 INTEGER :: zbhitwe, zbhitns 681 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdeptht, zrhh 680 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdept, zrhh 682 681 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 683 682 !!---------------------------------------------------------------------- 684 683 ! 685 684 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 686 CALL wrk_alloc( jpi,jpj,jpk, zdept ht, zrhh )685 CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 687 686 ! 688 687 IF( kt == nit000 ) THEN … … 717 716 END DO 718 717 719 ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdeptht(:,:,:)" 720 DO jj = 1, jpj 721 DO ji = 1, jpi 722 zdeptht(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) 723 zdeptht(ji,jj,1) = zdeptht(ji,jj,1) - sshn(ji,jj) * znad 724 DO jk = 2, jpk 725 zdeptht(ji,jj,jk) = zdeptht(ji,jj,jk-1) + fse3w(ji,jj,jk) 726 END DO 727 END DO 728 END DO 729 730 DO jk = 1, jpkm1 731 DO jj = 1, jpj 732 DO ji = 1, jpi 733 fsp(ji,jj,jk) = zrhh(ji,jj,jk) 734 xsp(ji,jj,jk) = zdeptht(ji,jj,jk) 735 END DO 736 END DO 737 END DO 718 ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 719 DO jj = 1, jpj; DO ji = 1, jpi 720 zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 721 END DO ; END DO 722 723 DO jk = 2, jpk; DO jj = 1, jpj; DO ji = 1, jpi 724 zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 725 END DO ; END DO ; END DO 726 727 fsp(:,:,:) = zrhh(:,:,:) 728 xsp(:,:,:) = zdept(:,:,:) 738 729 739 730 ! Construct the vertical density profile with the … … 745 736 DO jj = 2, jpj 746 737 DO ji = 2, jpi 747 zrhdt1 = zrhh(ji,jj,1) - interp3(zdept ht(ji,jj,1),asp(ji,jj,1), &738 zrhdt1 = zrhh(ji,jj,1) - interp3(zdept(ji,jj,1),asp(ji,jj,1), & 748 739 bsp(ji,jj,1), csp(ji,jj,1), & 749 dsp(ji,jj,1) ) * 0.5_wp * zdeptht(ji,jj,1) 750 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water 740 dsp(ji,jj,1) ) * 0.25_wp * fse3w(ji,jj,1) 751 741 752 742 ! assuming linear profile across the top half surface layer … … 760 750 DO ji = 2, jpi 761 751 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + & 762 integ 2(zdeptht(ji,jj,jk-1), zdeptht(ji,jj,jk),&752 integ_spline(zdept(ji,jj,jk-1), zdept(ji,jj,jk),& 763 753 asp(ji,jj,jk-1), bsp(ji,jj,jk-1), & 764 754 csp(ji,jj,jk-1), dsp(ji,jj,jk-1)) … … 793 783 END DO 794 784 785 DO jk = 1, jpkm1 786 DO jj = 2, jpjm1 787 DO ji = 2, jpim1 788 zu(ji,jj,jk) = min(zu(ji,jj,jk), max(-zdept(ji,jj,jk), -zdept(ji+1,jj,jk))) 789 zu(ji,jj,jk) = max(zu(ji,jj,jk), min(-zdept(ji,jj,jk), -zdept(ji+1,jj,jk))) 790 zv(ji,jj,jk) = min(zv(ji,jj,jk), max(-zdept(ji,jj,jk), -zdept(ji,jj+1,jk))) 791 zv(ji,jj,jk) = max(zv(ji,jj,jk), min(-zdept(ji,jj,jk), -zdept(ji,jj+1,jk))) 792 END DO 793 END DO 794 END DO 795 796 795 797 DO jk = 1, jpkm1 796 798 DO jj = 2, jpjm1 … … 803 805 !!!!! for u equation 804 806 IF( jk <= mbku(ji,jj) ) THEN 805 IF( -zdept ht(ji+1,jj,mbku(ji,jj)) >= -zdeptht(ji,jj,mbku(ji,jj)) ) THEN807 IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 806 808 jis = ji + 1; jid = ji 807 809 ELSE … … 811 813 ! integrate the pressure on the shallow side 812 814 jk1 = jk 813 zbhitwe = 0 814 DO WHILE ( -zdeptht(jis,jj,jk1) > zuijk ) 815 DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 815 816 IF( jk1 == mbku(ji,jj) ) THEN 816 z bhitwe = 1817 zuijk = -zdept(jis,jj,jk1) 817 818 EXIT 818 819 ENDIF 819 zdeps = MIN(zdept ht(jis,jj,jk1+1), -zuijk)820 zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 820 821 zpwes = zpwes + & 821 integ 2(zdeptht(jis,jj,jk1), zdeps, &822 integ_spline(zdept(jis,jj,jk1), zdeps, & 822 823 asp(jis,jj,jk1), bsp(jis,jj,jk1), & 823 824 csp(jis,jj,jk1), dsp(jis,jj,jk1)) … … 825 826 END DO 826 827 827 IF(zbhitwe == 1) THEN828 zuijk = -zdeptht(jis,jj,jk1)829 ENDIF830 831 828 ! integrate the pressure on the deep side 832 829 jk1 = jk 833 zbhitwe = 0 834 DO WHILE ( -zdeptht(jid,jj,jk1) < zuijk ) 830 DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 835 831 IF( jk1 == 1 ) THEN 836 zbhitwe = 1 832 zdeps = zdept(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad) 833 zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), & 834 bsp(jid,jj,1), csp(jid,jj,1), & 835 dsp(jid,jj,1)) * zdeps 836 zpwed = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 837 837 EXIT 838 838 ENDIF 839 zdeps = MAX(zdept ht(jid,jj,jk1-1), -zuijk)839 zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 840 840 zpwed = zpwed + & 841 integ 2(zdeps, zdeptht(jid,jj,jk1), &841 integ_spline(zdeps, zdept(jid,jj,jk1), & 842 842 asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1), & 843 843 csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) … … 845 845 END DO 846 846 847 IF( zbhitwe == 1 ) THEN848 zdeps = zdeptht(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad)849 zrhdt1 = zrhh(jid,jj,1) - interp3(zdeptht(jid,jj,1), asp(jid,jj,1), &850 bsp(jid,jj,1), csp(jid,jj,1), &851 dsp(jid,jj,1)) * zdeps852 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water853 zpwed = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps854 ENDIF855 856 847 ! update the momentum trends in u direction 857 848 … … 870 861 !!!!! for v equation 871 862 IF( jk <= mbkv(ji,jj) ) THEN 872 IF( -zdept ht(ji,jj+1,mbkv(ji,jj)) >= -zdeptht(ji,jj,mbkv(ji,jj)) ) THEN863 IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 873 864 jjs = jj + 1; jjd = jj 874 865 ELSE … … 878 869 ! integrate the pressure on the shallow side 879 870 jk1 = jk 880 zbhitns = 0 881 DO WHILE ( -zdeptht(ji,jjs,jk1) > zvijk ) 871 DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 882 872 IF( jk1 == mbkv(ji,jj) ) THEN 883 z bhitns = 1873 zvijk = -zdept(ji,jjs,jk1) 884 874 EXIT 885 875 ENDIF 886 zdeps = MIN(zdept ht(ji,jjs,jk1+1), -zvijk)876 zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 887 877 zpnss = zpnss + & 888 integ 2(zdeptht(ji,jjs,jk1), zdeps, &878 integ_spline(zdept(ji,jjs,jk1), zdeps, & 889 879 asp(ji,jjs,jk1), bsp(ji,jjs,jk1), & 890 880 csp(ji,jjs,jk1), dsp(ji,jjs,jk1) ) … … 892 882 END DO 893 883 894 IF(zbhitns == 1) THEN895 zvijk = -zdeptht(ji,jjs,jk1)896 ENDIF897 898 884 ! integrate the pressure on the deep side 899 885 jk1 = jk 900 zbhitns = 0 901 DO WHILE ( -zdeptht(ji,jjd,jk1) < zvijk ) 886 DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 902 887 IF( jk1 == 1 ) THEN 903 zbhitns = 1 888 zdeps = zdept(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad) 889 zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), & 890 bsp(ji,jjd,1), csp(ji,jjd,1), & 891 dsp(ji,jjd,1) ) * zdeps 892 zpnsd = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 904 893 EXIT 905 894 ENDIF 906 zdeps = MAX(zdept ht(ji,jjd,jk1-1), -zvijk)895 zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 907 896 zpnsd = zpnsd + & 908 integ 2(zdeps, zdeptht(ji,jjd,jk1), &897 integ_spline(zdeps, zdept(ji,jjd,jk1), & 909 898 asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 910 899 csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) … … 912 901 END DO 913 902 914 IF( zbhitns == 1 ) THEN915 zdeps = zdeptht(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad)916 zrhdt1 = zrhh(ji,jjd,1) - interp3(zdeptht(ji,jjd,1), asp(ji,jjd,1), &917 bsp(ji,jjd,1), csp(ji,jjd,1), &918 dsp(ji,jjd,1) ) * zdeps919 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water920 zpnsd = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps921 ENDIF922 903 923 904 ! update the momentum trends in v direction … … 941 922 ! 942 923 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 943 CALL wrk_dealloc( jpi,jpj,jpk, zdept ht, zrhh )924 CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 944 925 ! 945 926 END SUBROUTINE hpg_prj … … 1121 1102 1122 1103 1123 FUNCTION integ 2(xl, xr, a, b, c, d) RESULT(f)1104 FUNCTION integ_spline(xl, xr, a, b, c, d) RESULT(f) 1124 1105 !!---------------------------------------------------------------------- 1125 1106 !! *** ROUTINE interp1 *** … … 1143 1124 & xl * ( a + xl * ( za1 + xl * ( za2 + za3 * xl ) ) ) 1144 1125 1145 END FUNCTION integ 21126 END FUNCTION integ_spline 1146 1127 1147 1128 1148 1129 !!====================================================================== 1149 1130 END MODULE dynhpg 1131 -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r3294 r3570 118 118 IF( PRESENT(tab2d_1) ) ztab2d_1(:,:) = tab2d_1(:,:) 119 119 IF( PRESENT(tab2d_2) ) ztab2d_2(:,:) = tab2d_2(:,:) 120 IF( PRESENT(tab3d_1) ) ztab3d_1(:,:,1:kdir) = tab3d_1(:,:, :)121 IF( PRESENT(tab3d_2) ) ztab3d_2(:,:,1:kdir) = tab3d_2(:,:, :)120 IF( PRESENT(tab3d_1) ) ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,1:kdir) 121 IF( PRESENT(tab3d_2) ) ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,1:kdir) 122 122 IF( PRESENT(mask1) ) zmask1 (:,:,:) = mask1 (:,:,:) 123 123 IF( PRESENT(mask2) ) zmask2 (:,:,:) = mask2 (:,:,:) -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3294 r3570 80 80 END INTERFACE 81 81 INTERFACE mpp_sum 82 # if defined key_mpp_rep83 82 MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 84 83 mppsum_realdd, mppsum_a_realdd 85 # else86 MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real87 # endif88 84 END INTERFACE 89 85 INTERFACE mpp_lbc_north … … 114 110 !$AGRIF_END_DO_NOT_TREAT 115 111 116 # if defined key_mpp_rep117 112 INTEGER :: MPI_SUMDD 118 # endif119 113 120 114 ! variables used in case of sea-ice 121 INTEGER, PUBLIC :: ncomm_ice !: communicator made by the processors with sea-ice 115 INTEGER, PUBLIC :: ncomm_ice !: communicator made by the processors with sea-ice (public so that it can be freed in limthd) 116 INTEGER :: ngrp_iworld ! group ID for the world processors (for rheology) 122 117 INTEGER :: ngrp_ice ! group ID for the ice processors (for rheology) 123 118 INTEGER :: ndim_rank_ice ! number of 'ice' processors … … 355 350 mynode = mpprank 356 351 ! 357 #if defined key_mpp_rep358 352 CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 359 #endif360 353 ! 361 354 END FUNCTION mynode … … 1506 1499 END SUBROUTINE mppsum_real 1507 1500 1508 # if defined key_mpp_rep1509 1501 SUBROUTINE mppsum_realdd( ytab, kcom ) 1510 1502 !!---------------------------------------------------------------------- … … 1559 1551 1560 1552 END SUBROUTINE mppsum_a_realdd 1561 # endif1562 1553 1563 1554 SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) … … 1977 1968 !! ndim_rank_ice = number of processors with ice 1978 1969 !! nrank_ice (ndim_rank_ice) = ice processors 1979 !! ngrp_ world = group ID for the world processors1970 !! ngrp_iworld = group ID for the world processors 1980 1971 !! ngrp_ice = group ID for the ice processors 1981 1972 !! ncomm_ice = communicator for the ice procs. … … 2026 2017 2027 2018 ! Create the world group 2028 CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_ world, ierr )2019 CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_iworld, ierr ) 2029 2020 2030 2021 ! Create the ice group from the world group 2031 CALL MPI_GROUP_INCL( ngrp_ world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr )2022 CALL MPI_GROUP_INCL( ngrp_iworld, ndim_rank_ice, nrank_ice, ngrp_ice, ierr ) 2032 2023 2033 2024 ! Create the ice communicator , ie the pool of procs with sea-ice … … 2036 2027 ! Find proc number in the world of proc 0 in the north 2037 2028 ! The following line seems to be useless, we just comment & keep it as reminder 2038 ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr) 2039 ! 2029 ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_iworld,n_ice_root,ierr) 2030 ! 2031 CALL MPI_GROUP_FREE(ngrp_ice, ierr) 2032 CALL MPI_GROUP_FREE(ngrp_iworld, ierr) 2033 2040 2034 DEALLOCATE(kice, zwork) 2041 2035 ! … … 2599 2593 END SUBROUTINE mpi_init_opa 2600 2594 2601 #if defined key_mpp_rep2602 2595 SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype) 2603 2596 !!--------------------------------------------------------------------- … … 2628 2621 2629 2622 END SUBROUTINE DDPDD_MPI 2630 #endif2631 2623 2632 2624 #else -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r3294 r3570 721 721 ! ! (geographical to local grid -> rotate the components) 722 722 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 723 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid724 723 IF( srcv(jpr_otx2)%laction ) THEN 725 724 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) … … 727 726 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 728 727 ENDIF 728 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 729 729 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 730 730 ENDIF … … 949 949 ! ! (geographical to local grid -> rotate the components) 950 950 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 951 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid952 951 IF( srcv(jpr_itx2)%laction ) THEN 953 952 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) … … 955 954 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 956 955 ENDIF 956 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 957 957 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid 958 958 ENDIF -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3294 r3570 272 272 ! !== Misc. Options ==! 273 273 274 SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas 275 CASE( 1 ) ; CALL sbc_ice_if ( kt ) ! Ice-cover climatology ("Ice-if" model) 276 ! 277 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 278 IF( lk_bdy ) CALL bdy_ice_lim_2( kt ) ! BDY boundary condition 279 ! 280 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model 281 ! 282 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 274 SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas 275 CASE( 1 ) ; CALL sbc_ice_if ( kt ) ! Ice-cover climatology ("Ice-if" model) 276 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 277 IF( lk_bdy ) CALL bdy_ice_lim_2( kt ) ! BDY boundary condition 278 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model 279 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 283 280 END SELECT 284 281 285 IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes282 IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes 286 283 287 IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term288 289 IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget290 291 IF( n closea == 1 ) CALL sbc_clo( kt ) ! treatment of closed sea in the model domain292 ! ! (update freshwater fluxes)284 IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term 285 286 IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget 287 288 IF( nn_closea == 1 ) CALL sbc_clo( kt ) ! treatment of closed sea in the model domain 289 ! ! (update freshwater fluxes) 293 290 !RBbug do not understand why see ticket 667 294 291 CALL lbc_lnk( emp, 'T', 1. ) -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r3294 r3570 457 457 CALL iom_close( inum ) ! close file 458 458 459 IF( n closea == 1 ) CALL clo_rnf( rnfmsk )! closed sea inflow set as ruver mouth460 461 rnfmsk_z(:) = 0._wp 459 IF( nn_closea == 1 ) CALL clo_rnf( rnfmsk ) ! closed sea inflow set as ruver mouth 460 461 rnfmsk_z(:) = 0._wp ! vertical structure 462 462 rnfmsk_z(1) = 1.0 463 463 rnfmsk_z(2) = 1.0 ! ********** -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r3294 r3570 225 225 DO jj = 2, jpjm1 226 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2 v(ji,jj) + &228 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1 u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx227 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 228 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 229 229 END DO 230 230 END DO -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r3294 r3570 8 8 !! 3.3 ! 2010-06 (C. Ethe) merge TRA-TRC 9 9 !!---------------------------------------------------------------------- 10 #if defined key_trdtra || defined key_trd mld || defined key_trdmld_trc10 #if defined key_trdtra || defined key_trdtrc || defined key_trdmld || defined key_trdmld_trc 11 11 !!---------------------------------------------------------------------- 12 12 !! trd_tra : Call the trend to be computed -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r3294 r3570 227 227 ENDIF 228 228 ! 229 ! ! allocate zdfddm arrays229 ! ! allocate zdfddm arrays 230 230 IF( zdf_ddm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 231 ! ! initialization to masked Kz 232 avs(:,:,:) = rn_avt0 * tmask(:,:,:) 231 233 ! 232 234 END SUBROUTINE zdf_ddm_init -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r3294 r3570 87 87 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 88 88 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz 89 91 #if defined key_c1d 90 92 ! !!** 1D cfg only ** ('key_c1d') … … 112 114 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 113 115 #endif 114 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 116 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 117 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 118 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc ) 115 119 ! 116 120 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) … … 168 172 !!---------------------------------------------------------------------- 169 173 ! 174 IF( kt /= nit000 ) THEN ! restore before value to compute tke 175 avt (:,:,:) = avt_k (:,:,:) 176 avm (:,:,:) = avm_k (:,:,:) 177 avmu(:,:,:) = avmu_k(:,:,:) 178 avmv(:,:,:) = avmv_k(:,:,:) 179 ENDIF 180 ! 170 181 CALL tke_tke ! now tke (en) 171 182 ! 172 183 CALL tke_avn ! now avt, avm, avmu, avmv 184 ! 185 avt_k (:,:,:) = avt (:,:,:) 186 avm_k (:,:,:) = avm (:,:,:) 187 avmu_k(:,:,:) = avmu(:,:,:) 188 avmv_k(:,:,:) = avmv(:,:,:) 173 189 ! 174 190 END SUBROUTINE zdf_tke … … 811 827 ! ! ------------------- 812 828 IF(lwp) WRITE(numout,*) '---- tke-rst ----' 813 CALL iom_rstput( kt, nitrst, numrow, 'en' , en )814 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt 815 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm 816 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu 817 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv 818 CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl )829 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 830 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt_k ) 831 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm_k ) 832 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k ) 833 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k ) 834 CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl ) 819 835 ! 820 836 ENDIF -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r3294 r3570 14 14 !! of intrinsinc sign function 15 15 !!---------------------------------------------------------------------- 16 USE par_oce 17 USE lib_mpp ! distributed memory computing18 USE dom_oce ! ocean domain19 USE in_out_manager ! I/O manager16 USE par_oce ! Ocean parameter 17 USE dom_oce ! ocean domain 18 USE in_out_manager ! I/O manager 19 USE lib_mpp ! distributed memory computing 20 20 21 21 IMPLICIT NONE 22 22 PRIVATE 23 23 24 PUBLIC glob_sum 24 PUBLIC glob_sum ! used in many places 25 PUBLIC DDPDD ! also used in closea module 25 26 #if defined key_nosignedzero 26 27 PUBLIC SIGN … … 47 48 48 49 #if ! defined key_mpp_rep 50 49 51 FUNCTION glob_sum_2d( ptab ) 50 52 !!----------------------------------------------------------------------- … … 246 248 END FUNCTION glob_sum_3d_a 247 249 250 #endif 248 251 249 252 SUBROUTINE DDPDD( ydda, yddb ) … … 280 283 ! 281 284 END SUBROUTINE DDPDD 282 #endif283 285 284 286 #if defined key_nosignedzero -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3490 r3570 413 413 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt 414 414 WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench 415 WRITE(numout,*) ' timing activated (0/1) nn_timing = ', nn_timing 415 416 ENDIF 416 417 ! -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/OPA_SRC/timing.F90
r3294 r3570 76 76 LOGICAL :: ln_onefile = .TRUE. 77 77 LOGICAL :: lwriter 78 79 78 !!---------------------------------------------------------------------- 80 79 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 322 321 IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :' 323 322 IF( lwriter ) WRITE(numtime,*) '--------------------' 324 IF( lwriter ) WRITE(numtime, *) 'Elapsed Time (s) ','CPU Time (s)'325 IF( lwriter ) WRITE(numtime,'(5x,f12.3, 2x,f12.3)') tot_etime, tot_ctime323 IF( lwriter ) WRITE(numtime,"('Elapsed Time (s) CPU Time (s)')") 324 IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)') tot_etime, tot_ctime 326 325 IF( lwriter ) WRITE(numtime,*) 327 326 #if defined key_mpp_mpi … … 406 405 TYPE(timer), POINTER :: sl_timer_ave => NULL() 407 406 INTEGER :: icode 407 INTEGER :: ierr 408 408 LOGICAL :: ll_ord 409 409 CHARACTER(len=200) :: clfmt 410 410 411 411 ! Initialised the global strucutre 412 ALLOCATE(sl_timer_glob_root) 413 ALLOCATE(sl_timer_glob_root%cname (jpnij)) 414 ALLOCATE(sl_timer_glob_root%tsum_cpu (jpnij)) 415 ALLOCATE(sl_timer_glob_root%tsum_clock(jpnij)) 416 ALLOCATE(sl_timer_glob_root%niter (jpnij)) 412 ALLOCATE(sl_timer_glob_root, Stat=ierr) 413 IF(ierr /= 0)THEN 414 WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info' 415 RETURN 416 END IF 417 418 ALLOCATE(sl_timer_glob_root%cname (jpnij), & 419 sl_timer_glob_root%tsum_cpu (jpnij), & 420 sl_timer_glob_root%tsum_clock(jpnij), & 421 sl_timer_glob_root%niter (jpnij), Stat=ierr) 422 IF(ierr /= 0)THEN 423 WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info' 424 RETURN 425 END IF 417 426 sl_timer_glob_root%cname(:) = '' 418 427 sl_timer_glob_root%tsum_cpu(:) = 0._wp … … 421 430 sl_timer_glob_root%next => NULL() 422 431 sl_timer_glob_root%prev => NULL() 423 ALLOCATE(sl_timer_glob) 424 ALLOCATE(sl_timer_glob%cname (jpnij)) 425 ALLOCATE(sl_timer_glob%tsum_cpu (jpnij)) 426 ALLOCATE(sl_timer_glob%tsum_clock(jpnij)) 427 ALLOCATE(sl_timer_glob%niter (jpnij)) 432 !ARPDBG - don't need to allocate a pointer that's immediately then 433 ! set to point to some other object. 434 !ALLOCATE(sl_timer_glob) 435 !ALLOCATE(sl_timer_glob%cname (jpnij)) 436 !ALLOCATE(sl_timer_glob%tsum_cpu (jpnij)) 437 !ALLOCATE(sl_timer_glob%tsum_clock(jpnij)) 438 !ALLOCATE(sl_timer_glob%niter (jpnij)) 428 439 sl_timer_glob => sl_timer_glob_root 429 440 ! … … 451 462 sl_timer_ave => sl_timer_ave_root 452 463 ENDIF 453 464 454 465 ! Gather info from all processors 455 466 s_timer => s_timer_root … … 467 478 sl_timer_glob%niter, 1, MPI_INTEGER, & 468 479 0, MPI_COMM_OPA, icode) 480 469 481 IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN 470 482 ALLOCATE(sl_timer_glob%next) … … 479 491 s_timer => s_timer%next 480 492 END DO 493 494 WRITE(*,*) 'ARPDBG: timing: done gathers' 481 495 482 496 IF( narea == 1 ) THEN … … 500 514 ENDIF 501 515 sl_timer_glob => sl_timer_glob%next 502 END DO 516 END DO 517 518 WRITE(*,*) 'ARPDBG: timing: done computing stats' 503 519 504 ! reorder the ave arged list by CPU time520 ! reorder the averaged list by CPU time 505 521 s_wrk => NULL() 506 522 sl_timer_ave => sl_timer_ave_root … … 509 525 sl_timer_ave => sl_timer_ave_root 510 526 DO WHILE( ASSOCIATED( sl_timer_ave%next ) ) 511 IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT 527 528 IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT 529 512 530 IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN 513 531 ALLOCATE(s_wrk) 532 ! Copy data into the new object pointed to by s_wrk 514 533 s_wrk = sl_timer_ave%next 534 ! Insert this new timer object before our current position 515 535 CALL insert (sl_timer_ave, sl_timer_ave_root, s_wrk) 536 ! Remove the old object from the list 516 537 CALL suppress(sl_timer_ave%next) 517 538 ll_ord = .FALSE. 518 539 CYCLE 519 540 ENDIF 520 IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next541 IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next 521 542 END DO 522 IF( ll_ord ) EXIT543 IF( ll_ord ) EXIT 523 544 END DO 524 545 525 546 ! write averaged info 526 WRITE(numtime,*) 'Averaged timing on all processors :' 527 WRITE(numtime,*) '-----------------------------------' 528 WRITE(numtime,*) 'Section ', & 529 & 'Elapsed Time (s) ','Elapsed Time (%) ', & 530 & 'CPU Time(s) ','CPU Time (%) ','CPU/Elapsed ', & 531 & 'Max Elapsed (%) ','Min elapsed (%) ', & 532 & 'Frequency' 547 WRITE(numtime,"('Averaged timing on all processors :')") 548 WRITE(numtime,"('-----------------------------------')") 549 WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, & 550 & 'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x, & 551 & 'Max elap(%)',2x,'Min elap(%)',2x, & 552 & 'Freq')") 533 553 sl_timer_ave => sl_timer_ave_root 534 clfmt = '( 1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,5x,f12.3,5x,f12.3,2x,f9.2)'554 clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)' 535 555 DO WHILE ( ASSOCIATED(sl_timer_ave) ) 536 WRITE(numtime,TRIM(clfmt)) sl_timer_ave%cname , &556 WRITE(numtime,TRIM(clfmt)) sl_timer_ave%cname(1:18), & 537 557 & sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime, & 538 558 & sl_timer_ave%tsum_cpu ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime , & … … 712 732 !!---------------------------------------------------------------------- 713 733 l_initdone = .TRUE. 714 IF(lwp) WRITE(numout,*)715 IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing'716 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'717 CALL timing_list(s_timer_root)718 WRITE(numout,*)734 ! IF(lwp) WRITE(numout,*) 735 ! IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing' 736 ! IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 737 ! CALL timing_list(s_timer_root) 738 ! WRITE(numout,*) 719 739 ! 720 740 END SUBROUTINE timing_reset … … 734 754 !!---------------------------------------------------------------------- 735 755 !! *** ROUTINE insert *** 736 !! ** Purpose : insert an element in 756 !! ** Purpose : insert an element in timer structure 737 757 !!---------------------------------------------------------------------- 738 758 TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr … … 740 760 741 761 IF( ASSOCIATED( sd_current, sd_root ) ) THEN 762 ! If our current element is the root element then 763 ! replace it with the one being inserted 742 764 sd_root => sd_ptr 743 765 ELSE … … 747 769 sd_ptr%prev => sd_current%prev 748 770 sd_current%prev => sd_ptr 771 ! Nullify the pointer to the new element now that it is held 772 ! within the list. If we don't do this then a subsequent call 773 ! to ALLOCATE memory to this pointer will fail. 774 sd_ptr => NULL() 749 775 ! 750 776 END SUBROUTINE insert … … 764 790 IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev 765 791 DEALLOCATE(sl_temp) 792 sl_temp => NULL() 766 793 ! 767 794 END SUBROUTINE suppress -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
r3295 r3570 295 295 ENDIF 296 296 ! 297 CALL wrk_ alloc( jpi, jpj, jpk, znum3d )297 CALL wrk_dealloc( jpi, jpj, jpk, znum3d ) 298 298 ! 299 299 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink') -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r3294 r3570 101 101 END SELECT 102 102 103 IF( l_trdtr a) THEN ! save the vertical diffusive trends for further diagnostics103 IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics 104 104 DO jn = 1, jptra 105 105 DO jk = 1, jpkm1 -
branches/2012/dev_r3327_MERCATOR1_BDY/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90
r3294 r3570 59 59 ! Mixed layer trends for passive tracers 60 60 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 61 #if defined key_trdmld_trc 61 62 IF( lk_trdmld_trc .AND. ln_trdtrc( kjn ) ) THEN 62 63 ! … … 82 83 ! 83 84 END IF 85 #endif 84 86 85 87 IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN 86 88 ! 87 89 SELECT CASE( ktrd ) 88 CASE( jptra_trd_xad ) ; WRITE (cltra,'("XAD_",16a)') ctrcnm(kjn) 89 CASE( jptra_trd_yad ) ; WRITE (cltra,'("YAD_",16a)') ctrcnm(kjn) 90 CASE( jptra_trd_zad ) ; WRITE (cltra,'("ZAD_",16a)') ctrcnm(kjn) 91 CASE( jptra_trd_ldf ) ; WRITE (cltra,'("LDF_",16a)') ctrcnm(kjn) 92 CASE( jptra_trd_bbl ) ; WRITE (cltra,'("BBL_",16a)') ctrcnm(kjn) 93 CASE( jptra_trd_zdf ) ; WRITE (cltra,'("ZDF_",16a)') ctrcnm(kjn) 94 CASE( jptra_trd_dmp ) ; WRITE (cltra,'("DMP_",16a)') ctrcnm(kjn) 95 CASE( jptra_trd_nsr ) ; WRITE (cltra,'("FOR_",16a)') ctrcnm(kjn) 90 CASE( jptra_trd_xad ) ; WRITE (cltra,'("XAD_",4a)') 91 CASE( jptra_trd_yad ) ; WRITE (cltra,'("YAD_",4a)') 92 CASE( jptra_trd_zad ) ; WRITE (cltra,'("ZAD_",4a)') 93 CASE( jptra_trd_ldf ) ; WRITE (cltra,'("LDF_",4a)') 94 CASE( jptra_trd_bbl ) ; WRITE (cltra,'("BBL_",4a)') 95 CASE( jptra_trd_nsr ) ; WRITE (cltra,'("FOR_",4a)') 96 CASE( jptra_trd_zdf ) ; WRITE (cltra,'("ZDF_",4a)') 97 CASE( jptra_trd_dmp ) ; WRITE (cltra,'("DMP_",4a)') 98 CASE( jptra_trd_sms ) ; WRITE (cltra,'("SMS_",4a)') 99 CASE( jptra_trd_atf ) ; WRITE (cltra,'("ATF_",4a)') 100 CASE( jptra_trd_radb ) ; WRITE (cltra,'("RDB_",4a)') 101 CASE( jptra_trd_radn ) ; WRITE (cltra,'("RDN_",4a)') 96 102 END SELECT 103 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 97 104 CALL iom_put( cltra, ptrtrd(:,:,:) ) 98 105 ! … … 111 118 !!---------------------------------------------------------------------- 112 119 120 #if defined key_trdmld_trc 113 121 CALL trd_mld_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends 122 #endif 114 123 115 124 END SUBROUTINE trd_mod_trc_bio
Note: See TracChangeset
for help on using the changeset viewer.
