Changeset 2076 for branches/devmercator2010
- Timestamp:
- 2010-09-08T18:17:25+02:00 (14 years ago)
- Location:
- branches/devmercator2010/NEMO
- Files:
-
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/devmercator2010/NEMO/LIM_SRC_2/dom_ice_2.F90
r1228 r2076 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 03-08 (C. Ethe) Free form and module 7 !! 3.3 ! 09-05 (G.Garric) addition of the lim2_evp cas 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim2 … … 26 27 & area , & !: surface of grid cell 27 28 & tms , tmu !: temperature and velocity points masks 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: wght , & !: weight of the 4 neighbours to compute averages 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: wght !: weight of the 4 neighbours to compute averages 30 31 #if defined key_lim2_vp 32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: & 29 33 & akappa , bkappa !: first and third group of metric coefficients 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) :: alambd !: second group of metric coefficients 31 34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) :: alambd !: second group of metric coefficients 35 #else 36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmv , tmf !: y-velocity and F-points masks 37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmi !: ice mask: =1 if ice thick > 0 38 #endif 32 39 !!====================================================================== 33 40 #endif -
branches/devmercator2010/NEMO/LIM_SRC_2/ice_2.F90
r1756 r2076 5 5 !!===================================================================== 6 6 !! History : 2.0 ! 03-08 (C. Ethe) F90: Free form and module 7 !! 3.3 ! 09-05 (G.Garric) addition of the lim2_evp cas 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim2 … … 25 26 LOGICAL , PUBLIC :: ln_limdyn = .TRUE. !: flag for ice dynamics (T) or not (F) 26 27 LOGICAL , PUBLIC :: ln_limdmp = .FALSE. !: Ice damping 28 LOGICAL , PUBLIC :: ln_nicep = .TRUE. !: flag for sea-ice points output (T) or not (F) 27 29 REAL(wp) , PUBLIC :: hsndif = 0.e0 !: computation of temp. in snow (0) or not (9999) 28 30 REAL(wp) , PUBLIC :: hicdif = 0.e0 !: computation of temp. in ice (0) or not (9999) … … 46 48 REAL(wp), PUBLIC :: ecc = 2.e0 !: eccentricity of the elliptical yield curve 47 49 REAL(wp), PUBLIC :: ahi0 = 350.e0 !: sea-ice hor. eddy diffusivity coeff. (m2/s) 48 50 INTEGER , PUBLIC :: nevp = 360 !: number of EVP subcycling iterations 51 INTEGER , PUBLIC :: telast = 3600 !: timescale for EVP elastic waves 52 REAL(wp), PUBLIC :: alphaevp = 1.e0 !: coefficient for the solution of EVP int. stresses 49 53 REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( ecc * ecc ) 50 54 REAL(wp), PUBLIC :: rhoco !: = rau0 * cw … … 52 56 REAL(wp), PUBLIC :: pstarh !: pstar / 2.0 53 57 54 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ahiu , ahiv !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 55 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: pahu , pahv !: ice hor. eddy diffusivity coef. at ocean U- and V-points 56 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hsnm , hicm !: mean snow and ice thicknesses 57 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ust2s !: friction velocity 58 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ahiu , ahiv !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 59 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: pahu , pahv !: ice hor. eddy diffusivity coef. at ocean U- and V-points 60 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ust2s !: friction velocity 61 62 #if defined key_lim2_vp 63 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hsnm , hicm !: mean snow and ice thicknesses 64 CHARACTER(len=1), PUBLIC :: cl_grid = 'B' !: type of grid used in ice dynamics, 'C' or 'B' 65 #else 66 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & 67 stress1_i , &!: first stress tensor element 68 stress2_i , &!: second stress tensor element 69 stress12_i, &!: diagonal stress tensor element 70 delta_i , &!: Delta factor for the ice rheology (see Flato and Hibler 95) [s-1] -> limrhg.F90 71 divu_i , &!: Divergence of the velocity field [s-1] -> limrhg.F90 72 shear_i !: Shear of the velocity field [s-1] -> limrhg.F90 73 74 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: at_i !: 75 REAL(wp), PUBLIC, DIMENSION(:,:) ,POINTER :: vt_s ,vt_i !: mean snow and ice thicknesses 76 REAL(wp), PUBLIC, DIMENSION(jpi,jpj),TARGET :: hsnm , hicm !: mean snow and ice thicknesses, target for pointers vt_s and vt_i 77 CHARACTER(len=1), PUBLIC :: cl_grid = 'C' !: type of grid used in ice dynamics, 'C' or 'B' 78 #endif 58 79 59 80 !!* diagnostic quantities 81 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdvosif !: Variation of volume at surface (only used for outputs) 82 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdvobif !: Variation of ice volume at the bottom ice (only used for outputs) 83 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fdvolif !: Total variation of ice volume (only used for outputs) 84 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdvonif !: Lateral Variation of ice volume (only used for outputs) 60 85 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sist !: Sea-Ice Surface Temperature (Kelvin) 61 86 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tfu !: Freezing/Melting point temperature of sea water at SSS -
branches/devmercator2010/NEMO/LIM_SRC_2/iceini_2.F90
r1581 r2076 6 6 !! History : 1.0 ! 02-08 (G. Madec) F90: Free form and modules 7 7 !! 2.0 ! 03-08 (C. Ethe) add ice_run 8 !! 3.3 ! 09-05 (G.Garric) addition of the lim2_evp case 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_lim2 … … 30 31 31 32 PUBLIC ice_init_2 ! called by sbcice_lim_2.F90 33 34 INTEGER , PUBLIC :: numit !: iteration number 35 32 36 33 37 !!---------------------------------------------------------------------- … … 62 66 ENDIF 63 67 64 tn_ice(:,:,1) = sist(:,:) 68 tn_ice(:,:,1) = sist(:,:) ! initialisation of ice temperature 65 69 fr_i (:,:) = 1.0 - frld(:,:) ! initialisation of sea-ice fraction 70 ! 71 numit = nit000 - 1 !initialisation ice time-step 72 66 73 ! 67 74 END SUBROUTINE ice_init_2 -
branches/devmercator2010/NEMO/LIM_SRC_2/limdyn_2.F90
r1694 r2076 8 8 !! 2.0 ! 03-08 (C. Ethe) add lim_dyn_init 9 9 !! 2.0 ! 06-07 (G. Madec) Surface module 10 !! 3.3 ! 09-05 (G.Garric) addition of the lim2_evp cas 10 11 !!--------------------------------------------------------------------- 11 12 #if defined key_lim2 … … 22 23 USE dom_ice_2 ! 23 24 USE limistate_2 ! 25 #if defined key_lim2_vp 24 26 USE limrhg_2 ! ice rheology 25 27 #else 28 USE limrhg ! ice rheology 29 #endif 26 30 USE lbclnk ! 27 31 USE lib_mpp ! … … 87 91 i_jpj = jpj 88 92 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 93 #if defined key_lim2_vp 89 94 CALL lim_rhg_2( i_j1, i_jpj ) 95 #else 96 CALL lim_rhg( i_j1, i_jpj ) !!!!cbr CALL lim_rhg( i_j1, i_jpj, kt ) 97 #endif 90 98 ! 91 99 ELSE ! optimization of the computational area … … 105 113 i_j1 = i_j1 + 1 106 114 END DO 115 #if defined key_lim2_vp 107 116 i_j1 = MAX( 1, i_j1-1 ) 108 117 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 109 118 ! 110 119 CALL lim_rhg_2( i_j1, i_jpj ) 120 #else 121 i_j1 = MAX( 1, i_j1-2 ) 122 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 123 CALL lim_rhg( i_j1, i_jpj ) 124 #endif 111 125 ! 112 126 ! Southern hemisphere … … 116 130 i_jpj = i_jpj - 1 117 131 END DO 132 #if defined key_lim2_vp 118 133 i_jpj = MIN( jpj, i_jpj+2 ) 119 134 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 120 135 ! 121 136 CALL lim_rhg_2( i_j1, i_jpj ) 137 #else 138 i_jpj = MIN( jpj, i_jpj+1 ) 139 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 140 CALL lim_rhg( i_j1, i_jpj ) !!!!cbr CALL lim_rhg( i_j1, i_jpj, kt ) 141 #endif 122 142 ! 123 143 ELSE ! local domain extends over one hemisphere only … … 134 154 i_jpj = i_jpj - 1 135 155 END DO 156 #if defined key_lim2_vp 136 157 i_jpj = MIN( jpj, i_jpj+2) 137 158 138 159 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 139 160 ! 140 161 CALL lim_rhg_2( i_j1, i_jpj ) 162 #else 163 i_j1 = MAX( 1, i_j1-2 ) 164 i_jpj = MIN( jpj, i_jpj+1) 165 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 166 CALL lim_rhg( i_j1, i_jpj ) !!!!cbr CALL lim_rhg( i_j1, i_jpj, kt ) 167 #endif 141 168 ! 142 169 ENDIF … … 148 175 ! computation of friction velocity 149 176 ! -------------------------------- 177 178 SELECT CASE( cl_grid ) 179 180 CASE( 'C' ) ! C-grid ice dynamics 181 !????????????????????????????????? 182 ! ice-ocean velocity at U & V-points (u_ice vi_ice at U- & V-points ; ssu_m, ssv_m at U- & V-points) 183 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 184 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 185 186 187 CASE( 'B' ) ! B-grid ice dynamics 150 188 ! ice-ocean velocity at U & V-points (u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points) 151 189 … … 156 194 END DO 157 195 END DO 196 197 END SELECT 198 158 199 ! frictional velocity at T-point 159 200 DO jj = 2, jpjm1 … … 198 239 NAMELIST/namicedyn/ epsd, alpha, & 199 240 & dm, nbiter, nbitdr, om, resl, cw, angvg, pstar, & 200 & c_rhg, etamn, creepl, ecc, ahi0 241 & c_rhg, etamn, creepl, ecc, ahi0, & 242 & nevp, telast, alphaevp 201 243 !!------------------------------------------------------------------- 202 244 … … 223 265 WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ', ecc 224 266 WRITE(numout,*) ' horizontal diffusivity coeff. for sea-ice ahi0 = ', ahi0 267 WRITE(numout,*) ' number of iterations for subcycling nevp = ', nevp 268 WRITE(numout,*) ' timescale for elastic waves telast = ', telast 269 WRITE(numout,*) ' coefficient for the solution of int. stresses alphaevp = ', alphaevp 225 270 ENDIF 226 271 -
branches/devmercator2010/NEMO/LIM_SRC_2/limmsh_2.F90
r2072 r2076 47 47 !! original : 01-04 (LIM) 48 48 !! addition : 02-08 (C. Ethe, G. Madec) 49 !! additions : 2009-05 (addition of the lim2_evp case, G. Garric) 49 50 !!--------------------------------------------------------------------- 50 51 !! * Local variables 51 52 INTEGER :: ji, jj ! dummy loop indices 52 53 54 REAL(wp) :: & 55 zusden ! temporary scalars 56 #if defined key_lim2_vp 53 57 REAL(wp), DIMENSION(jpi,jpj) :: & 54 58 zd2d1 , zd1d2 ! Derivative of zh2 (resp. zh1) in the x direction … … 57 61 zh1p , zh2p , & ! Idem zh1, zh2 for the bottom left corner of the grid 58 62 zd2d1p, zd1d2p , & ! Idem zd2d1, zd1d2 for the bottom left corner of the grid 59 zusden, zusden2 ! temporary scalars 63 zusden2 ! temporary scalars 64 #endif 60 65 !!--------------------------------------------------------------------- 61 66 … … 112 117 !------------------- 113 118 !!ibug ??? 114 akappa(:,:,:,:) = 0.e0115 119 wght(:,:,:,:) = 0.e0 120 tmu(:,:) = 0.e0 121 #if defined key_lim2_vp 122 akappa(:,:,:,:) = 0.e0 116 123 alambd(:,:,:,:,:,:) = 0.e0 117 tmu(:,:) = 0.e0 124 #else 125 tmv(:,:) = 0.e0 126 tmf(:,:) = 0.e0 127 #endif 118 128 !!i 119 129 120 130 #if defined key_lim2_vp 121 131 ! metric coefficients for sea ice dynamic 122 132 !---------------------------------------- … … 152 162 CALL lbc_lnk( wght(:,:,2,1), 'I', 1. ) ! but it is never used 153 163 CALL lbc_lnk( wght(:,:,2,2), 'I', 1. ) 164 #else 165 ! ! weights (wght) 166 DO jj = 2, jpj-1 167 DO ji = 2, jpi-1 168 zusden = 1. / ( ( e1t(ji+1,jj) + e1t(ji,jj ) ) & 169 & * ( e2t(ji,jj+1) + e2t(ji ,jj) ) ) 170 wght(ji,jj,1,1) = zusden * e1t(ji+1,jj) * e2t(ji,jj+1) 171 wght(ji,jj,1,2) = zusden * e1t(ji+1,jj) * e2t(ji,jj ) 172 wght(ji,jj,2,1) = zusden * e1t(ji ,jj) * e2t(ji,jj+1) 173 wght(ji,jj,2,2) = zusden * e1t(ji ,jj) * e2t(ji,jj ) 174 END DO 175 END DO 176 177 !With EVP, the weights are calculated on 'F' points 178 CALL lbc_lnk( wght(:,:,1,1), 'F', 1. ) ! CAUTION: even with the lbc_lnk at ice U-V-point 179 CALL lbc_lnk( wght(:,:,1,2), 'F', 1. ) ! the value of wght at jpj is wrong 180 CALL lbc_lnk( wght(:,:,2,1), 'F', 1. ) ! but it is never used 181 CALL lbc_lnk( wght(:,:,2,2), 'F', 1. ) 182 183 #endif 154 184 155 185 ! Coefficients for divergence of the stress tensor 156 186 !------------------------------------------------- 157 187 188 #if defined key_lim2_vp 158 189 DO jj = 2, jpj 159 190 DO ji = 2, jpi ! NO vector opt. … … 223 254 CALL lbc_lnk( alambd(:,:,2,1,1,1), 'I', 1. ) ! 224 255 CALL lbc_lnk( alambd(:,:,2,1,1,2), 'I', 1. ) ! 256 #endif 225 257 226 258 … … 233 265 tmu(:,1) = 0.e0 234 266 tmu(1,:) = 0.e0 267 268 #if defined key_lim2_vp 235 269 DO jj = 2, jpj ! ice U.V-point: computed from ice T-point mask 236 270 DO ji = 2, jpim1 ! NO vector opt. … … 241 275 !--lateral boundary conditions 242 276 CALL lbc_lnk( tmu(:,:), 'I', 1. ) 277 #else 278 tmv(:,1) = 0.e0 !SB 279 tmv(1,:) = 0.e0 !SB 280 tmf(1,:) = 0.e0 281 tmf(:,1) = 0.e0 282 DO jj = 1, jpj - 1 283 DO ji = 1 , jpi - 1 284 tmu(ji,jj) = tms(ji,jj) * tms(ji+1,jj) 285 tmv(ji,jj) = tms(ji,jj) * tms(ji,jj+1) 286 tmf(ji,jj) = tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * & 287 tms(ji+1,jj+1) 288 END DO 289 END DO 290 291 !--lateral boundary conditions 292 CALL lbc_lnk( tmu(:,:), 'U', 1. ) 293 CALL lbc_lnk( tmv(:,:), 'V', 1. ) 294 CALL lbc_lnk( tmf(:,:), 'F', 1. ) 295 #endif 243 296 244 297 ! unmasked and masked area of T-grid cell -
branches/devmercator2010/NEMO/LIM_SRC_2/limrhg_2.F90
r1774 r2076 9 9 !! " " ! 06-08 (G. Madec) surface module, ice-stress at I-point 10 10 !! " " ! 09-09 (G. Madec) Huge verctor optimisation 11 !!---------------------------------------------------------------------- 12 #if defined key_lim2 11 !! 3.3 ! 09-05 (G.Garric) addition of the lim2_evp case 12 !!---------------------------------------------------------------------- 13 #if defined key_lim2 && defined key_lim2_vp 13 14 !!---------------------------------------------------------------------- 14 15 !! 'key_lim2' LIM 2.0 sea-ice model -
branches/devmercator2010/NEMO/LIM_SRC_2/limrst_2.F90
r1715 r2076 6 6 !! History : 2.0 ! 01-04 (C. Ethe, G. Madec) Original code 7 7 !! ! 06-07 (S. Masson) use IOM for restart read/write 8 !! 3.3 ! 09-05 (G.Garric) addition of the lim2_evp case 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_lim2 … … 108 109 CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter, wp) ) 109 110 110 CALL iom_rstput( iter, nitrst, numriw, 'hicif' , hicif (:,:) ) ! prognostic variables 111 CALL iom_rstput( iter, nitrst, numriw, 'hsnif' , hsnif (:,:) ) 112 CALL iom_rstput( iter, nitrst, numriw, 'frld' , frld (:,:) ) 113 CALL iom_rstput( iter, nitrst, numriw, 'sist' , sist (:,:) ) 114 CALL iom_rstput( iter, nitrst, numriw, 'tbif1' , tbif (:,:,1) ) 115 CALL iom_rstput( iter, nitrst, numriw, 'tbif2' , tbif (:,:,2) ) 116 CALL iom_rstput( iter, nitrst, numriw, 'tbif3' , tbif (:,:,3) ) 117 CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice (:,:) ) 118 CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice (:,:) ) 119 CALL iom_rstput( iter, nitrst, numriw, 'qstoif', qstoif(:,:) ) 120 CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq (:,:) ) 121 CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice (:,:) ) 122 CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice (:,:) ) 123 CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice(:,:) ) 124 CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice(:,:) ) 125 CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice(:,:) ) 126 CALL iom_rstput( iter, nitrst, numriw, 'sxsn' , sxsn (:,:) ) 127 CALL iom_rstput( iter, nitrst, numriw, 'sysn' , sysn (:,:) ) 128 CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn (:,:) ) 129 CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn (:,:) ) 130 CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn (:,:) ) 131 CALL iom_rstput( iter, nitrst, numriw, 'sxa' , sxa (:,:) ) 132 CALL iom_rstput( iter, nitrst, numriw, 'sya' , sya (:,:) ) 133 CALL iom_rstput( iter, nitrst, numriw, 'sxxa' , sxxa (:,:) ) 134 CALL iom_rstput( iter, nitrst, numriw, 'syya' , syya (:,:) ) 135 CALL iom_rstput( iter, nitrst, numriw, 'sxya' , sxya (:,:) ) 136 CALL iom_rstput( iter, nitrst, numriw, 'sxc0' , sxc0 (:,:) ) 137 CALL iom_rstput( iter, nitrst, numriw, 'syc0' , syc0 (:,:) ) 138 CALL iom_rstput( iter, nitrst, numriw, 'sxxc0' , sxxc0 (:,:) ) 139 CALL iom_rstput( iter, nitrst, numriw, 'syyc0' , syyc0 (:,:) ) 140 CALL iom_rstput( iter, nitrst, numriw, 'sxyc0' , sxyc0 (:,:) ) 141 CALL iom_rstput( iter, nitrst, numriw, 'sxc1' , sxc1 (:,:) ) 142 CALL iom_rstput( iter, nitrst, numriw, 'syc1' , syc1 (:,:) ) 143 CALL iom_rstput( iter, nitrst, numriw, 'sxxc1' , sxxc1 (:,:) ) 144 CALL iom_rstput( iter, nitrst, numriw, 'syyc1' , syyc1 (:,:) ) 145 CALL iom_rstput( iter, nitrst, numriw, 'sxyc1' , sxyc1 (:,:) ) 146 CALL iom_rstput( iter, nitrst, numriw, 'sxc2' , sxc2 (:,:) ) 147 CALL iom_rstput( iter, nitrst, numriw, 'syc2' , syc2 (:,:) ) 148 CALL iom_rstput( iter, nitrst, numriw, 'sxxc2' , sxxc2 (:,:) ) 149 CALL iom_rstput( iter, nitrst, numriw, 'syyc2' , syyc2 (:,:) ) 150 CALL iom_rstput( iter, nitrst, numriw, 'sxyc2' , sxyc2 (:,:) ) 151 CALL iom_rstput( iter, nitrst, numriw, 'sxst' , sxst (:,:) ) 152 CALL iom_rstput( iter, nitrst, numriw, 'syst' , syst (:,:) ) 153 CALL iom_rstput( iter, nitrst, numriw, 'sxxst' , sxxst (:,:) ) 154 CALL iom_rstput( iter, nitrst, numriw, 'syyst' , syyst (:,:) ) 155 CALL iom_rstput( iter, nitrst, numriw, 'sxyst' , sxyst (:,:) ) 111 CALL iom_rstput( iter, nitrst, numriw, 'hicif' , hicif (:,:) ) ! prognostic variables 112 CALL iom_rstput( iter, nitrst, numriw, 'hsnif' , hsnif (:,:) ) 113 CALL iom_rstput( iter, nitrst, numriw, 'frld' , frld (:,:) ) 114 CALL iom_rstput( iter, nitrst, numriw, 'sist' , sist (:,:) ) 115 CALL iom_rstput( iter, nitrst, numriw, 'tbif1' , tbif (:,:,1) ) 116 CALL iom_rstput( iter, nitrst, numriw, 'tbif2' , tbif (:,:,2) ) 117 CALL iom_rstput( iter, nitrst, numriw, 'tbif3' , tbif (:,:,3) ) 118 CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice (:,:) ) 119 CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice (:,:) ) 120 CALL iom_rstput( iter, nitrst, numriw, 'qstoif' , qstoif (:,:) ) 121 CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq (:,:) ) 122 #if ! defined key_lim2_vp 123 CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i (:,:) ) 124 CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i (:,:) ) 125 CALL iom_rstput( iter, nitrst, numriw, 'stress12_i' , stress12_i(:,:) ) 126 #endif 127 CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice (:,:) ) 128 CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice (:,:) ) 129 CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice (:,:) ) 130 CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice (:,:) ) 131 CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice (:,:) ) 132 CALL iom_rstput( iter, nitrst, numriw, 'sxsn' , sxsn (:,:) ) 133 CALL iom_rstput( iter, nitrst, numriw, 'sysn' , sysn (:,:) ) 134 CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn (:,:) ) 135 CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn (:,:) ) 136 CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn (:,:) ) 137 CALL iom_rstput( iter, nitrst, numriw, 'sxa' , sxa (:,:) ) 138 CALL iom_rstput( iter, nitrst, numriw, 'sya' , sya (:,:) ) 139 CALL iom_rstput( iter, nitrst, numriw, 'sxxa' , sxxa (:,:) ) 140 CALL iom_rstput( iter, nitrst, numriw, 'syya' , syya (:,:) ) 141 CALL iom_rstput( iter, nitrst, numriw, 'sxya' , sxya (:,:) ) 142 CALL iom_rstput( iter, nitrst, numriw, 'sxc0' , sxc0 (:,:) ) 143 CALL iom_rstput( iter, nitrst, numriw, 'syc0' , syc0 (:,:) ) 144 CALL iom_rstput( iter, nitrst, numriw, 'sxxc0' , sxxc0 (:,:) ) 145 CALL iom_rstput( iter, nitrst, numriw, 'syyc0' , syyc0 (:,:) ) 146 CALL iom_rstput( iter, nitrst, numriw, 'sxyc0' , sxyc0 (:,:) ) 147 CALL iom_rstput( iter, nitrst, numriw, 'sxc1' , sxc1 (:,:) ) 148 CALL iom_rstput( iter, nitrst, numriw, 'syc1' , syc1 (:,:) ) 149 CALL iom_rstput( iter, nitrst, numriw, 'sxxc1' , sxxc1 (:,:) ) 150 CALL iom_rstput( iter, nitrst, numriw, 'syyc1' , syyc1 (:,:) ) 151 CALL iom_rstput( iter, nitrst, numriw, 'sxyc1' , sxyc1 (:,:) ) 152 CALL iom_rstput( iter, nitrst, numriw, 'sxc2' , sxc2 (:,:) ) 153 CALL iom_rstput( iter, nitrst, numriw, 'syc2' , syc2 (:,:) ) 154 CALL iom_rstput( iter, nitrst, numriw, 'sxxc2' , sxxc2 (:,:) ) 155 CALL iom_rstput( iter, nitrst, numriw, 'syyc2' , syyc2 (:,:) ) 156 CALL iom_rstput( iter, nitrst, numriw, 'sxyc2' , sxyc2 (:,:) ) 157 CALL iom_rstput( iter, nitrst, numriw, 'sxst' , sxst (:,:) ) 158 CALL iom_rstput( iter, nitrst, numriw, 'syst' , syst (:,:) ) 159 CALL iom_rstput( iter, nitrst, numriw, 'sxxst' , sxxst (:,:) ) 160 CALL iom_rstput( iter, nitrst, numriw, 'syyst' , syyst (:,:) ) 161 CALL iom_rstput( iter, nitrst, numriw, 'sxyst' , sxyst (:,:) ) 156 162 157 163 IF( iter == nitrst ) THEN … … 218 224 ENDIF 219 225 220 CALL iom_get( numrir, jpdom_autoglo, 'qstoif', qstoif ) 221 CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq ) 222 CALL iom_get( numrir, jpdom_autoglo, 'sxice' , sxice ) 223 CALL iom_get( numrir, jpdom_autoglo, 'syice' , syice ) 224 CALL iom_get( numrir, jpdom_autoglo, 'sxxice', sxxice ) 225 CALL iom_get( numrir, jpdom_autoglo, 'syyice', syyice ) 226 CALL iom_get( numrir, jpdom_autoglo, 'sxyice', sxyice ) 227 CALL iom_get( numrir, jpdom_autoglo, 'sxsn' , sxsn ) 228 CALL iom_get( numrir, jpdom_autoglo, 'sysn' , sysn ) 229 CALL iom_get( numrir, jpdom_autoglo, 'sxxsn' , sxxsn ) 230 CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn ) 231 CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn ) 232 CALL iom_get( numrir, jpdom_autoglo, 'sxa' , sxa ) 233 CALL iom_get( numrir, jpdom_autoglo, 'sya' , sya ) 234 CALL iom_get( numrir, jpdom_autoglo, 'sxxa' , sxxa ) 235 CALL iom_get( numrir, jpdom_autoglo, 'syya' , syya ) 236 CALL iom_get( numrir, jpdom_autoglo, 'sxya' , sxya ) 237 CALL iom_get( numrir, jpdom_autoglo, 'sxc0' , sxc0 ) 238 CALL iom_get( numrir, jpdom_autoglo, 'syc0' , syc0 ) 239 CALL iom_get( numrir, jpdom_autoglo, 'sxxc0' , sxxc0 ) 240 CALL iom_get( numrir, jpdom_autoglo, 'syyc0' , syyc0 ) 241 CALL iom_get( numrir, jpdom_autoglo, 'sxyc0' , sxyc0 ) 242 CALL iom_get( numrir, jpdom_autoglo, 'sxc1' , sxc1 ) 243 CALL iom_get( numrir, jpdom_autoglo, 'syc1' , syc1 ) 244 CALL iom_get( numrir, jpdom_autoglo, 'sxxc1' , sxxc1 ) 245 CALL iom_get( numrir, jpdom_autoglo, 'syyc1' , syyc1 ) 246 CALL iom_get( numrir, jpdom_autoglo, 'sxyc1' , sxyc1 ) 247 CALL iom_get( numrir, jpdom_autoglo, 'sxc2' , sxc2 ) 248 CALL iom_get( numrir, jpdom_autoglo, 'syc2' , syc2 ) 249 CALL iom_get( numrir, jpdom_autoglo, 'sxxc2' , sxxc2 ) 250 CALL iom_get( numrir, jpdom_autoglo, 'syyc2' , syyc2 ) 251 CALL iom_get( numrir, jpdom_autoglo, 'sxyc2' , sxyc2 ) 252 CALL iom_get( numrir, jpdom_autoglo, 'sxst' , sxst ) 253 CALL iom_get( numrir, jpdom_autoglo, 'syst' , syst ) 254 CALL iom_get( numrir, jpdom_autoglo, 'sxxst' , sxxst ) 255 CALL iom_get( numrir, jpdom_autoglo, 'syyst' , syyst ) 256 CALL iom_get( numrir, jpdom_autoglo, 'sxyst' , sxyst ) 226 CALL iom_get( numrir, jpdom_autoglo, 'qstoif' , qstoif ) 227 CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq ) 228 #if ! defined key_lim2_vp 229 CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i ) 230 CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i ) 231 CALL iom_get( numrir, jpdom_autoglo, 'stress12_i' , stress12_i ) 232 #endif 233 CALL iom_get( numrir, jpdom_autoglo, 'sxice' , sxice ) 234 CALL iom_get( numrir, jpdom_autoglo, 'syice' , syice ) 235 CALL iom_get( numrir, jpdom_autoglo, 'sxxice' , sxxice ) 236 CALL iom_get( numrir, jpdom_autoglo, 'syyice' , syyice ) 237 CALL iom_get( numrir, jpdom_autoglo, 'sxyice' , sxyice ) 238 CALL iom_get( numrir, jpdom_autoglo, 'sxsn' , sxsn ) 239 CALL iom_get( numrir, jpdom_autoglo, 'sysn' , sysn ) 240 CALL iom_get( numrir, jpdom_autoglo, 'sxxsn' , sxxsn ) 241 CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn ) 242 CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn ) 243 CALL iom_get( numrir, jpdom_autoglo, 'sxa' , sxa ) 244 CALL iom_get( numrir, jpdom_autoglo, 'sya' , sya ) 245 CALL iom_get( numrir, jpdom_autoglo, 'sxxa' , sxxa ) 246 CALL iom_get( numrir, jpdom_autoglo, 'syya' , syya ) 247 CALL iom_get( numrir, jpdom_autoglo, 'sxya' , sxya ) 248 CALL iom_get( numrir, jpdom_autoglo, 'sxc0' , sxc0 ) 249 CALL iom_get( numrir, jpdom_autoglo, 'syc0' , syc0 ) 250 CALL iom_get( numrir, jpdom_autoglo, 'sxxc0' , sxxc0 ) 251 CALL iom_get( numrir, jpdom_autoglo, 'syyc0' , syyc0 ) 252 CALL iom_get( numrir, jpdom_autoglo, 'sxyc0' , sxyc0 ) 253 CALL iom_get( numrir, jpdom_autoglo, 'sxc1' , sxc1 ) 254 CALL iom_get( numrir, jpdom_autoglo, 'syc1' , syc1 ) 255 CALL iom_get( numrir, jpdom_autoglo, 'sxxc1' , sxxc1 ) 256 CALL iom_get( numrir, jpdom_autoglo, 'syyc1' , syyc1 ) 257 CALL iom_get( numrir, jpdom_autoglo, 'sxyc1' , sxyc1 ) 258 CALL iom_get( numrir, jpdom_autoglo, 'sxc2' , sxc2 ) 259 CALL iom_get( numrir, jpdom_autoglo, 'syc2' , syc2 ) 260 CALL iom_get( numrir, jpdom_autoglo, 'sxxc2' , sxxc2 ) 261 CALL iom_get( numrir, jpdom_autoglo, 'syyc2' , syyc2 ) 262 CALL iom_get( numrir, jpdom_autoglo, 'sxyc2' , sxyc2 ) 263 CALL iom_get( numrir, jpdom_autoglo, 'sxst' , sxst ) 264 CALL iom_get( numrir, jpdom_autoglo, 'syst' , syst ) 265 CALL iom_get( numrir, jpdom_autoglo, 'sxxst' , sxxst ) 266 CALL iom_get( numrir, jpdom_autoglo, 'syyst' , syyst ) 267 CALL iom_get( numrir, jpdom_autoglo, 'sxyst' , sxyst ) 257 268 258 269 CALL iom_close( numrir ) -
branches/devmercator2010/NEMO/LIM_SRC_2/limsbc_2.F90
r2072 r2076 7 7 !! 02-07 (C. Ethe, G. Madec) re-writing F90 8 8 !! 06-07 (G. Madec) surface module 9 !! 09-05 (G.Garric) addition of the lim2_evp case 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim2 … … 88 89 REAL(wp) :: zfrldu, zfrldv ! lead fraction at U- & V-points 89 90 REAL(wp) :: zutau , zvtau ! lead fraction at U- & V-points 91 !!! REAL(wp) :: zutaui , zvtaui ! lead fraction at U- & V-points 90 92 REAL(wp) :: zu_io , zv_io ! 2 components of the ice-ocean velocity 91 93 ! interface 2D --> 3D … … 275 277 DO ji = 2, jpim1 ! NO vector opt. 276 278 ! ... components of ice-ocean stress at U and V-points (from I-point values) 279 #if defined key_lim2_vp 277 280 zutau = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) ) 278 281 zvtau = 0.5 * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) ) 282 #else 283 zutau = ztio_u(ji,jj) 284 zvtau = ztio_v(ji,jj) 285 #endif 279 286 ! ... open-ocean (lead) fraction at U- & V-points (from T-point values) 280 287 zfrldu = 0.5 * ( frld(ji,jj) + frld(ji+1,jj ) ) -
branches/devmercator2010/NEMO/LIM_SRC_2/limtrp_2.F90
r2072 r2076 67 67 !! ! 01-05 (G. Madec, R. Hordoir) opa norm 68 68 !! 2.0 ! 04-01 (G. Madec, C. Ethe) F90, mpp 69 !! 3.3 ! 09-05 (G.Garric) addition of the lim2_evp case 69 70 !!--------------------------------------------------------------------- 70 71 INTEGER, INTENT(in) :: kt ! number of iteration … … 107 108 ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions. 108 109 zvbord = 1.0 + ( 1.0 - bound ) 110 #if defined key_lim2_vp 109 111 DO jj = 1, jpjm1 110 112 DO ji = 1, jpim1 ! NO vector opt. … … 116 118 CALL lbc_lnk( zui_u, 'U', -1. ) 117 119 CALL lbc_lnk( zvi_v, 'V', -1. ) 120 #else 121 zui_u(:,:)=u_ice(:,:) 122 zvi_v(:,:)=v_ice(:,:) 123 #endif 118 124 119 125 ! CFL test for stability -
branches/devmercator2010/NEMO/LIM_SRC_3/limrhg.F90
r1469 r2076 7 7 !! 3.0 ! 2008-03 (M. Vancoppenolle) LIM3 8 8 !! - ! 2008-11 (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy 9 !! - ! 2009-05 (G.Garric) addition of the lim2_evp cas 9 10 !!---------------------------------------------------------------------- 10 #if defined key_lim3 11 #if defined key_lim3 || ( defined key_lim2 && ! defined key_lim2_vp ) 11 12 !!---------------------------------------------------------------------- 12 13 !! 'key_lim3' LIM3 sea-ice model … … 18 19 USE par_oce 19 20 USE dom_oce 20 USE dom_ice21 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE ice24 USE iceini25 23 USE lbclnk 26 24 USE lib_mpp … … 28 26 USE limitd_me 29 27 USE prtctl ! Print control 30 28 #if defined key_lim3 29 USE dom_ice 30 USE ice 31 USE iceini 32 #endif 33 #if defined key_lim2 && ! defined key_lim2_vp 34 USE dom_ice_2 35 USE ice_2 36 USE iceini_2 37 #endif 31 38 32 39 IMPLICIT NONE … … 180 187 zresr !: Local error on velocity 181 188 189 #if defined key_lim2 && ! defined key_lim2_vp 190 vt_s => hsnm 191 vt_i => hicm 192 at_i(:,:) = 1. - frld(:,:) 193 #endif 182 194 ! 183 195 !------------------------------------------------------------------------------! … … 190 202 u_ice2(:,:) = 0.0 ; v_ice1(:,:) = 0.0 191 203 zdd(:,:) = 0.0 ; zdt(:,:) = 0.0 ; zds(:,:) = 0.0 192 204 #if defined key_lim3 193 205 ! Ice strength on T-points 194 206 CALL lim_itd_me_icestrength(ridge_scheme_swi) 207 #endif 195 208 196 209 ! Ice mass and temp variables … … 200 213 DO ji = 1 , jpi 201 214 zc1(ji,jj) = tms(ji,jj) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) ) 215 #if defined key_lim3 202 216 zpresh(ji,jj) = tms(ji,jj) * strength(ji,jj) / 2. 217 #else 218 zpresh(ji,jj) = tms(ji,jj) * 2. * pstar * hicm(ji,jj) * EXP( -c_rhg * frld(ji,jj) ) 219 #endif 203 220 ! tmi = 1 where there is ice or on land 204 221 tmi(ji,jj) = 1.0 - ( 1.0 - MAX( 0.0 , SIGN ( 1.0 , vt_i(ji,jj) - & … … 269 286 / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 270 287 ! 288 ! Mass, coriolis coeff. and currents 271 289 u_oce1(ji,jj) = u_oce(ji,jj) 272 290 v_oce2(ji,jj) = v_oce(ji,jj) -
branches/devmercator2010/NEMO/OPA_SRC/DOM/daymod.F90
r2075 r2076 67 67 !! - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 68 68 !!---------------------------------------------------------------------- 69 INTEGER :: inbday, irest70 REAL(wp) :: zjul71 !!----------------------------------------------------------------------72 69 73 70 ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0 … … 108 105 ! day since january 1st 109 106 nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 110 111 !compute number of days between last monday and today 112 IF( nn_leapy==1 )THEN 113 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (monday) 114 inbday = INT(fjulday) - NINT(zjul) ! compute nb day between 01.01.1900 and current day fjulday 115 irest = MOD(inbday,7) ! compute nb day between last monday and current day fjulday 116 IF(irest==0 )irest = 7 117 ENDIF 118 107 119 108 ! number of seconds since the beginning of current year/month at the middle of the time-step 120 109 nsec_year = nday_year * nsecd - ndt05 ! 1 time step before the middle of the first time step 121 110 nsec_month = nday * nsecd - ndt05 ! because day will be called at the beginning of step 122 111 nsec_day = nsecd - ndt05 123 nsec_week = 0124 IF( nn_leapy==1 ) nsec_week = irest * nsecd - ndt05125 112 126 113 ! control print 127 114 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ', & 128 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day , ' nsec_week:', nsec_week115 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day 129 116 130 117 ! Up to now, calendar parameters are related to the end of previous run (nit000-1) … … 213 200 nsec_year = nsec_year + ndt 214 201 nsec_month = nsec_month + ndt 215 IF( nn_leapy==1 ) nsec_week = nsec_week + ndt216 202 nsec_day = nsec_day + ndt 217 203 adatrj = adatrj + rdttra(1) / rday … … 242 228 ndastp = nyear * 10000 + nmonth * 100 + nday ! NEW date 243 229 ! 244 !compute first day of the year in julian days245 CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )246 !247 230 IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt, & 248 231 & ' New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, ' nday_year = ', nday_year 249 232 IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') ' nsec_year = ', nsec_year, & 250 & ' nsec_month = ', nsec_month, ' nsec_day = ', nsec_day, ' nsec_week = ', nsec_week 251 ENDIF 252 253 IF( nsec_week .GT. 7*86400 ) nsec_week = ndt05 233 & ' nsec_month = ', nsec_month, ' nsec_day = ', nsec_day 234 ENDIF 254 235 255 236 IF(ln_ctl) THEN -
branches/devmercator2010/NEMO/OPA_SRC/DOM/dom_oce.F90
r2075 r2076 195 195 !! calendar variables 196 196 !! --------------------------------------------------------------------- 197 INTEGER , PUBLIC :: nyear !: current year 198 INTEGER , PUBLIC :: nmonth !: current month 199 INTEGER , PUBLIC :: nday !: current day of the month 200 INTEGER , PUBLIC :: ndastp !: time step date in yyyymmdd format 201 INTEGER , PUBLIC :: nday_year !: current day counted from jan 1st of the current year 202 INTEGER , PUBLIC :: nsec_year !: current time step counted in second since 00h jan 1st of the current year 203 INTEGER , PUBLIC :: nsec_month !: current time step counted in second since 00h 1st day of the current month 204 INTEGER , PUBLIC :: nsec_week !: current time step counted in second since 00h of last monday 205 INTEGER , PUBLIC :: nsec_day !: current time step counted in second since 00h of the current day 206 REAL(wp), PUBLIC :: fjulday !: current julian day 207 REAL(wp), PUBLIC :: fjulstartyear !: first day of the current year in julian days 208 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the whole simulation 209 ! !: (cumulative duration of previous runs that may have used different time-step size) 197 INTEGER , PUBLIC :: nyear !: current year 198 INTEGER , PUBLIC :: nmonth !: current month 199 INTEGER , PUBLIC :: nday !: current day of the month 200 INTEGER , PUBLIC :: ndastp !: time step date in yyyymmdd format 201 INTEGER , PUBLIC :: nday_year !: current day counted from jan 1st of the current year 202 INTEGER , PUBLIC :: nsec_year !: current time step counted in second since 00h jan 1st of the current year 203 INTEGER , PUBLIC :: nsec_month !: current time step counted in second since 00h 1st day of the current month 204 INTEGER , PUBLIC :: nsec_day !: current time step counted in second since 00h of the current day 205 REAL(wp), PUBLIC :: fjulday !: julian day 206 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the whole simulation 207 ! !: (cumulative duration of previous runs that may have used different time-step size) 210 208 INTEGER , PUBLIC, DIMENSION(0: 1) :: nyear_len !: length in days of the previous/current year 211 209 INTEGER , PUBLIC, DIMENSION(0:13) :: nmonth_len !: length in days of the months of the current year -
branches/devmercator2010/NEMO/OPA_SRC/SBC/fldread.F90
r2075 r2076 15 15 USE oce ! ocean dynamics and tracers 16 16 USE dom_oce ! ocean space and time domain 17 USE ioipsl, ONLY : ymds2ju, ju2ymds ! for calendar18 17 USE phycst ! ??? 19 18 USE in_out_manager ! I/O manager … … 30 29 LOGICAL :: ln_tint ! time interpolation or not (T/F) 31 30 LOGICAL :: ln_clim ! climatology or not (T/F) 32 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly'31 CHARACTER(len = 7) :: cltype ! type of data file 'daily', 'monthly' or yearly' 33 32 CHARACTER(len = 34) :: wname ! generic name of a NetCDF weights file to be used, blank if not 34 33 CHARACTER(len = 34) :: vcomp ! symbolic component name if a vector that needs rotation … … 44 43 LOGICAL :: ln_tint ! time interpolation or not (T/F) 45 44 LOGICAL :: ln_clim ! climatology or not (T/F) 46 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly'45 CHARACTER(len = 7) :: cltype ! type of data file 'daily', 'monthly' or yearly' 47 46 INTEGER :: num ! iom id of the jpfld files to be read 48 47 INTEGER :: nswap_sec ! swapping time in second since Jan. 1st 00h of nit000 year … … 160 159 IF( sd(jf)%nfreqh == -1 ) THEN ; ireclast = 12 161 160 ELSE 162 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 163 ELSEIF( sd(jf)%cltype(1:4) == 'week' ) THEN ; ireclast = 24.* 7 / sd(jf)%nfreqh 164 ELSEIF( sd(jf)%cltype == 'daily' ) THEN ; ireclast = 24 / sd(jf)%nfreqh 165 ELSE ; ireclast = 24 * nyear_len( 1 ) / sd(jf)%nfreqh 161 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 162 ELSEIF( sd(jf)%cltype == 'daily' ) THEN ; ireclast = 24 / sd(jf)%nfreqh 163 ELSE ; ireclast = 24 * nyear_len( 1 ) / sd(jf)%nfreqh 166 164 ENDIF 167 165 ENDIF … … 315 313 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 316 314 !! 317 LOGICAL :: llprevyr ! are we reading previous year file? 318 LOGICAL :: llprevmth ! are we reading previous month file? 319 LOGICAL :: llprevweek ! are we reading previous week file? 320 LOGICAL :: llprevday ! are we reading previous day file? 321 LOGICAL :: llprev ! llprevyr .OR. llprevmth .OR. llprevday 322 INTEGER :: idvar ! variable id 323 INTEGER :: inrec ! number of record existing for this variable 315 LOGICAL :: llprevyr ! are we reading previous year file? 316 LOGICAL :: llprevmth ! are we reading previous month file? 317 LOGICAL :: llprevday ! are we reading previous day file? 318 LOGICAL :: llprev ! llprevyr .OR. llprevmth .OR. llprevday 319 INTEGER :: idvar ! variable id 320 INTEGER :: inrec ! number of record existing for this variable 324 321 INTEGER :: kwgt 325 INTEGER :: iyear, imonth, iday ! first day of the current file in yyyy mm dd326 INTEGER :: isec_week ! number of seconds since start of the weekly file327 322 CHARACTER(LEN=1000) :: clfmt ! write format 328 323 !!--------------------------------------------------------------------- 329 324 330 325 ! some default definitions... 331 326 sdjf%num = 0 ! default definition for non-opened file 332 327 IF( sdjf%ln_clim ) sdjf%clname = TRIM( sdjf%clrootname ) ! file name defaut definition, never change in this case 333 llprevyr = .FALSE. 334 llprevmth = .FALSE. 335 llprevweek = .FALSE. 336 llprevday = .FALSE. 337 isec_week = 0 328 llprevyr = .FALSE. 329 llprevmth = .FALSE. 330 llprevday = .FALSE. 338 331 339 332 ! define record informations … … 357 350 llprevmth = .NOT. sdjf%ln_clim ! use previous month file? 358 351 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 359 ELSE IF ( sdjf%cltype(1:4) == 'week' ) THEN !weekly file360 isec_week = 86400 * 7361 sdjf%nrec_b(1) = 24. / sdjf%nfreqh * 7 ! last record of previous weekly file362 352 ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file 363 353 sdjf%nrec_b(1) = 24 / sdjf%nfreqh ! last record of previous day … … 371 361 ENDIF 372 362 ENDIF 373 llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 374 375 IF ( sdjf%cltype(1:4) == 'week' ) THEN 376 isec_week = ksec_week( sdjf%cltype(6:8) ) 377 if(lwp)write(numout,*)'cbr test2 isec_week = ',isec_week 378 llprevmth = ( isec_week .GT. nsec_month ) 379 llprevyr = llprevmth .AND. nmonth==1 380 ENDIF 381 ! 382 iyear = nyear - COUNT((/llprevyr /)) 383 imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 384 iday = nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - INT( isec_week )/86400 385 ! 386 CALL fld_clopn( sdjf , iyear , imonth , iday , .NOT. llprev ) 387 363 llprev = llprevyr .OR. llprevmth .OR. llprevday 364 365 CALL fld_clopn( sdjf, nyear - COUNT((/llprevyr /)) , & 366 & nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)), & 367 & nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 368 388 369 ! if previous year/month/day file does not exist, we switch to the current year/month/day 389 370 IF( llprev .AND. sdjf%num == 0 ) THEN … … 418 399 ENDIF 419 400 420 ! make sure current year/month/day file is opened 421 IF( sdjf%num == 0 ) THEN 422 isec_week = 0 423 llprevyr = .FALSE. 424 llprevmth = .FALSE. 425 llprevweek = .FALSE. 426 ! 427 IF ( sdjf%cltype(1:4) == 'week' ) THEN 428 isec_week = ksec_week( sdjf%cltype(6:8) ) 429 llprevmth = ( isec_week .GT. nsec_month ) 430 llprevyr = llprevmth .AND. nmonth==1 431 ENDIF 432 ! 433 iyear = nyear - COUNT((/llprevyr /)) 434 imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 435 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week/86400 436 ! 437 CALL fld_clopn( sdjf, iyear, imonth, iday ) 438 ENDIF 401 IF( sdjf%num == 0 ) CALL fld_clopn( sdjf, nyear, nmonth, nday ) ! make sure current year/month/day file is opened 439 402 440 403 sdjf%nswap_sec = nsec_year + nsec1jan000 - 1 ! force read/update the after data in the following part of fld_read 441 404 442 405 END SUBROUTINE fld_init 443 406 … … 457 420 REAL(wp) :: ztmp ! temporary variable 458 421 INTEGER :: ifreq_sec ! frequency mean (in seconds) 459 INTEGER :: isec_week ! number of seconds since the start of the weekly file460 422 !!---------------------------------------------------------------------- 461 423 ! … … 491 453 ! 492 454 ifreq_sec = sdjf%nfreqh * 3600 ! frequency mean (in seconds) 493 IF( sdjf%cltype(1:4) == 'week' ) isec_week = ksec_week( sdjf%cltype(6:8)) !since the first day of the current week494 455 ! number of second since the beginning of the file 495 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = REAL(nsec_month ,wp) ! since 00h on the 1st day of the current month 496 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; ztmp = REAL(isec_week ,wp) ! since the first day of the current week 497 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ztmp = REAL(nsec_day ,wp) ! since 00h of the current day 498 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 456 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = REAL(nsec_month,wp) ! since 00h on the 1st day of the current month 457 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ztmp = REAL(nsec_day ,wp) ! since 00h of the current day 458 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 499 459 ENDIF 500 460 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record … … 532 492 ! after record index and second since Jan. 1st 00h of nit000 year 533 493 sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 534 IF( sdjf%cltype == 'monthly' ) 494 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month 535 495 sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1)) ! ok if nmonth=1 536 IF( sdjf%cltype(1:4) == 'week' ) & ! add the number of seconds between 00h Jan 1 and the end of previous week 537 sdjf%nrec_a(2) = sdjf%nrec_a(2) + ( nsec_year - isec_week ) 538 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 496 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 539 497 sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 ) 540 498 … … 542 500 irec = irec - 1. ! move back to previous record 543 501 sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 544 IF( sdjf%cltype == 'monthly' ) 502 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month 545 503 sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1)) ! ok if nmonth=1 546 IF( sdjf%cltype(1:4) == 'week' ) & ! add the number of seconds between 00h Jan 1 and the end of previous week 547 sdjf%nrec_b(2) = sdjf%nrec_b(2) + ( nsec_year - isec_week ) 548 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 504 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 549 505 sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 ) 550 506 … … 567 523 !! ** Method : 568 524 !!---------------------------------------------------------------------- 569 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 570 INTEGER , INTENT(in ) :: kyear ! year value 571 INTEGER , INTENT(in ) :: kmonth ! month value 572 INTEGER , INTENT(in ) :: kday ! day value 573 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 574 INTEGER :: iyear, imonth, iday ! firt day of the current week in yyyy mm dd 575 REAL(wp) :: zsec, zjul !temp variable 525 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 526 INTEGER , INTENT(in ) :: kyear ! year value 527 INTEGER , INTENT(in ) :: kmonth ! month value 528 INTEGER , INTENT(in ) :: kday ! day value 529 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 576 530 577 531 IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open 578 532 ! build the new filename if not climatological data 579 sdjf%clname=TRIM(sdjf%clrootname) 580 ! 581 IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy==0 )CALL ctl_stop( 'fld_clopn: weekly file and nn_leapy=0 are not compatible' ) 582 ! 583 IF( .NOT. sdjf%ln_clim ) THEN 584 WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 585 IF( sdjf%cltype /= 'yearly' ) & 586 & WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 587 IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 588 & WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 533 IF( .NOT. sdjf%ln_clim ) THEN ; WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 534 IF( sdjf%cltype /= 'yearly' ) WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 535 IF( sdjf%cltype == 'daily' ) WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 589 536 ENDIF 590 537 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) … … 1051 998 1052 999 END SUBROUTINE fld_interp 1053 1054 FUNCTION ksec_week( cdday ) 1055 !!--------------------------------------------------------------------- 1056 !! *** FUNCTION kshift_week *** 1057 !! 1058 !! ** Purpose : 1059 !! 1060 !! ** Method : 1061 !!--------------------------------------------------------------------- 1062 CHARACTER(len=*), INTENT(in) :: cdday !3 first letters of the first day of the weekly file 1063 !! 1064 INTEGER :: ksec_week ! output variable 1065 INTEGER :: ijul !temp variable 1066 INTEGER :: ishift !temp variable 1067 CHARACTER(len=3),DIMENSION(7) :: cl_week 1068 !!---------------------------------------------------------------------- 1069 cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/) 1070 DO ijul=1,7 1071 IF( cl_week(ijul)==TRIM(cdday) ) EXIT 1072 ENDDO 1073 IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): ',TRIM(cdday) ) 1074 ! 1075 ishift = ( ijul ) * 86400 1076 ! 1077 ksec_week = nsec_week + ishift 1078 ksec_week = MOD( ksec_week , 86400*7 ) 1079 if(lwp)write(numout,*)'cbr ijul ksec_week ',ijul,ksec_week 1080 ! 1081 END FUNCTION ksec_week 1082 1000 1083 1001 END MODULE fldread -
branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r1715 r2076 8 8 !! History : 1.0 ! 06-2006 (G. Madec) from icestp_2.F90 9 9 !! 3.0 ! 08-2008 (S. Masson, E. .... ) coupled interface 10 !! 3.3 ! 05-2009 (G.Garric) addition of the lim2_evp case 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_lim2 … … 53 54 PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90 54 55 55 CHARACTER(len=1) :: cl_grid = 'B' ! type of grid used in ice dynamics56 57 56 !! * Substitutions 58 57 # include "domzgr_substitute.h90" … … 172 171 ! Ice model step ! 173 172 ! ---------------- ! 174 175 CALL lim_rst_opn_2 ( kt ) ! Open Ice restart file 176 IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (not in 1D case) 173 numit = numit + nn_fsbc ! Ice model time step 174 175 CALL lim_rst_opn_2 ( kt ) ! Open Ice restart file 176 IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (not in 1D case) 177 177 CALL lim_dyn_2 ( kt ) ! Ice dynamics ( rheology/dynamics ) 178 178 CALL lim_trp_2 ( kt ) ! Ice transport ( Advection/diffusion )
Note: See TracChangeset
for help on using the changeset viewer.