Changeset 2077
- Timestamp:
- 2010-09-09T10:43:51+02:00 (14 years ago)
- Location:
- branches/devmercator2010
- Files:
-
- 27 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/devmercator2010/CONFIG/ORCA2_LIM/EXP00/AA_job
r2075 r2077 117 117 118 118 #- Files for the configuration and ocean dynamics 119 Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3. 1.tar119 Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.2.tar 120 120 121 121 ls -alF -
branches/devmercator2010/CONFIG/ORCA2_LIM/EXP00/namelist
r2075 r2077 275 275 rn_alphdi = 0.72 ! (Pyane, 1972) 276 276 / 277 277 !----------------------------------------------------------------------- 278 &namdta_tem ! surface boundary condition : sea surface restoring 279 !----------------------------------------------------------------------- 280 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim !'yearly' or ! weights ! rotation ! 281 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 282 sn_tem = 'data_1m_potential_temperature_nomask', -1 , 'votemper' , .true. , .true. , 'yearly' , ' ' , ' ' 283 ! 284 cn_dir = './' ! root directory for the location of the runoff files 285 / 286 !----------------------------------------------------------------------- 287 &namdta_sal ! surface boundary condition : sea surface restoring 288 !----------------------------------------------------------------------- 289 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly' or ! weights ! rotation ! 290 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 291 sn_sal = 'data_1m_salinity_nomask' , -1 , 'vosaline' , .true. , .true. , 'yearly' , '' , ' ' 292 ! 293 cn_dir = './' ! root directory for the location of the runoff files 294 / 278 295 !!====================================================================== 279 296 !! *** Lateral boundary condition *** … … 417 434 ln_traadv_muscl2 = .false. ! MUSCL2 scheme + cen2 at boundaries 418 435 ln_traadv_ubs = .false. ! UBS scheme 436 !ln_traadv_ppm = .true. ! UBS scheme 419 437 / 420 438 !----------------------------------------------------------------------- … … 698 716 &namptr ! Poleward Transport Diagnostic 699 717 !----------------------------------------------------------------------- 700 ln_diaptr = . true. ! Poleward heat and salt transport (T) or not (F)718 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 701 719 ln_diaznl = .true. ! Add zonal means and meridional stream functions 702 720 ln_subbas = .true. ! Atlantic/Pacific/Indian basins computation (T) or not -
branches/devmercator2010/CONFIG/ORCA2_LIM_PISCES/EXP00/AA_job
r2075 r2077 117 117 118 118 #- Files for the configuration and ocean dynamics 119 Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3. 1.tar119 Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.2.tar 120 120 Rapatrie ${R_TMP} INPUTS_INIT_v3.tar 121 121 Rapatrie ${R_TMP} INPUTS_PISCES_v3.tar -
branches/devmercator2010/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist
r2075 r2077 275 275 rn_alphdi = 0.72 ! (Pyane, 1972) 276 276 / 277 277 !----------------------------------------------------------------------- 278 &namdta_tem ! surface boundary condition : sea surface restoring 279 !----------------------------------------------------------------------- 280 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim !'yearly' or ! weights ! rotation ! 281 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 282 sn_tem = 'data_1m_potential_temperature_nomask', -1 , 'votemper' , .true. , .true. , 'yearly' , ' ' , ' ' 283 ! 284 cn_dir = './' ! root directory for the location of the runoff files 285 / 286 !----------------------------------------------------------------------- 287 &namdta_sal ! surface boundary condition : sea surface restoring 288 !----------------------------------------------------------------------- 289 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly' or ! weights ! rotation ! 290 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 291 sn_sal = 'data_1m_salinity_nomask' , -1 , 'vosaline' , .true. , .true. , 'yearly' , '' , ' ' 292 ! 293 cn_dir = './' ! root directory for the location of the runoff files 294 / 278 295 !!====================================================================== 279 296 !! *** Lateral boundary condition *** -
branches/devmercator2010/NEMO/LIM_SRC_2/dom_ice_2.F90
r2076 r2077 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 cas8 7 !!---------------------------------------------------------------------- 9 8 #if defined key_lim2 … … 27 26 & area , & !: surface of grid cell 28 27 & tms , tmu !: temperature and velocity points masks 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: wght !: weight of the 4 neighbours to compute averages 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: wght , & !: weight of the 4 neighbours to compute averages 29 & 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 30 31 31 #if defined key_lim2_vp32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: &33 & akappa , bkappa !: first and third group of metric coefficients34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) :: alambd !: second group of metric coefficients35 #else36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmv , tmf !: y-velocity and F-points masks37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmi !: ice mask: =1 if ice thick > 038 #endif39 32 !!====================================================================== 40 33 #endif -
branches/devmercator2010/NEMO/LIM_SRC_2/ice_2.F90
r2076 r2077 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 cas8 7 !!---------------------------------------------------------------------- 9 8 #if defined key_lim2 … … 26 25 LOGICAL , PUBLIC :: ln_limdyn = .TRUE. !: flag for ice dynamics (T) or not (F) 27 26 LOGICAL , PUBLIC :: ln_limdmp = .FALSE. !: Ice damping 28 LOGICAL , PUBLIC :: ln_nicep = .TRUE. !: flag for sea-ice points output (T) or not (F)29 27 REAL(wp) , PUBLIC :: hsndif = 0.e0 !: computation of temp. in snow (0) or not (9999) 30 28 REAL(wp) , PUBLIC :: hicdif = 0.e0 !: computation of temp. in ice (0) or not (9999) … … 48 46 REAL(wp), PUBLIC :: ecc = 2.e0 !: eccentricity of the elliptical yield curve 49 47 REAL(wp), PUBLIC :: ahi0 = 350.e0 !: sea-ice hor. eddy diffusivity coeff. (m2/s) 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 48 53 49 REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( ecc * ecc ) 54 50 REAL(wp), PUBLIC :: rhoco !: = rau0 * cw … … 56 52 REAL(wp), PUBLIC :: pstarh !: pstar / 2.0 57 53 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 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 79 58 80 59 !!* 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)85 60 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sist !: Sea-Ice Surface Temperature (Kelvin) 86 61 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
r2076 r2077 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 case9 8 !!---------------------------------------------------------------------- 10 9 #if defined key_lim2 … … 31 30 32 31 PUBLIC ice_init_2 ! called by sbcice_lim_2.F90 33 34 INTEGER , PUBLIC :: numit !: iteration number35 36 32 37 33 !!---------------------------------------------------------------------- … … 66 62 ENDIF 67 63 68 tn_ice(:,:,1) = sist(:,:) ! initialisation of ice temperature64 tn_ice(:,:,1) = sist(:,:) ! initialisation of ice temperature 69 65 fr_i (:,:) = 1.0 - frld(:,:) ! initialisation of sea-ice fraction 70 !71 numit = nit000 - 1 !initialisation ice time-step72 73 66 ! 74 67 END SUBROUTINE ice_init_2 -
branches/devmercator2010/NEMO/LIM_SRC_2/limdyn_2.F90
r2076 r2077 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 cas11 10 !!--------------------------------------------------------------------- 12 11 #if defined key_lim2 … … 23 22 USE dom_ice_2 ! 24 23 USE limistate_2 ! 25 #if defined key_lim2_vp26 24 USE limrhg_2 ! ice rheology 27 #else 28 USE limrhg ! ice rheology 29 #endif 25 30 26 USE lbclnk ! 31 27 USE lib_mpp ! … … 91 87 i_jpj = jpj 92 88 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_vp94 89 CALL lim_rhg_2( i_j1, i_jpj ) 95 #else96 CALL lim_rhg( i_j1, i_jpj ) !!!!cbr CALL lim_rhg( i_j1, i_jpj, kt )97 #endif98 90 ! 99 91 ELSE ! optimization of the computational area … … 113 105 i_j1 = i_j1 + 1 114 106 END DO 115 #if defined key_lim2_vp116 107 i_j1 = MAX( 1, i_j1-1 ) 117 108 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 118 109 ! 119 110 CALL lim_rhg_2( i_j1, i_jpj ) 120 #else121 i_j1 = MAX( 1, i_j1-2 )122 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj123 CALL lim_rhg( i_j1, i_jpj )124 #endif125 111 ! 126 112 ! Southern hemisphere … … 130 116 i_jpj = i_jpj - 1 131 117 END DO 132 #if defined key_lim2_vp133 118 i_jpj = MIN( jpj, i_jpj+2 ) 134 119 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 135 120 ! 136 121 CALL lim_rhg_2( i_j1, i_jpj ) 137 #else138 i_jpj = MIN( jpj, i_jpj+1 )139 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj140 CALL lim_rhg( i_j1, i_jpj ) !!!!cbr CALL lim_rhg( i_j1, i_jpj, kt )141 #endif142 122 ! 143 123 ELSE ! local domain extends over one hemisphere only … … 154 134 i_jpj = i_jpj - 1 155 135 END DO 156 #if defined key_lim2_vp157 136 i_jpj = MIN( jpj, i_jpj+2) 158 137 159 138 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 160 139 ! 161 140 CALL lim_rhg_2( i_j1, i_jpj ) 162 #else163 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_jpj166 CALL lim_rhg( i_j1, i_jpj ) !!!!cbr CALL lim_rhg( i_j1, i_jpj, kt )167 #endif168 141 ! 169 142 ENDIF … … 175 148 ! computation of friction velocity 176 149 ! -------------------------------- 177 178 SELECT CASE( cl_grid )179 180 CASE( 'C' ) ! C-grid ice dynamics181 !?????????????????????????????????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 dynamics188 150 ! ice-ocean velocity at U & V-points (u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points) 189 151 … … 194 156 END DO 195 157 END DO 196 197 END SELECT198 199 158 ! frictional velocity at T-point 200 159 DO jj = 2, jpjm1 … … 239 198 NAMELIST/namicedyn/ epsd, alpha, & 240 199 & dm, nbiter, nbitdr, om, resl, cw, angvg, pstar, & 241 & c_rhg, etamn, creepl, ecc, ahi0, & 242 & nevp, telast, alphaevp 200 & c_rhg, etamn, creepl, ecc, ahi0 243 201 !!------------------------------------------------------------------- 244 202 … … 265 223 WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ', ecc 266 224 WRITE(numout,*) ' horizontal diffusivity coeff. for sea-ice ahi0 = ', ahi0 267 WRITE(numout,*) ' number of iterations for subcycling nevp = ', nevp268 WRITE(numout,*) ' timescale for elastic waves telast = ', telast269 WRITE(numout,*) ' coefficient for the solution of int. stresses alphaevp = ', alphaevp270 225 ENDIF 271 226 -
branches/devmercator2010/NEMO/LIM_SRC_2/limmsh_2.F90
r2076 r2077 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)50 49 !!--------------------------------------------------------------------- 51 50 !! * Local variables 52 51 INTEGER :: ji, jj ! dummy loop indices 53 52 54 REAL(wp) :: &55 zusden ! temporary scalars56 #if defined key_lim2_vp57 53 REAL(wp), DIMENSION(jpi,jpj) :: & 58 54 zd2d1 , zd1d2 ! Derivative of zh2 (resp. zh1) in the x direction … … 61 57 zh1p , zh2p , & ! Idem zh1, zh2 for the bottom left corner of the grid 62 58 zd2d1p, zd1d2p , & ! Idem zd2d1, zd1d2 for the bottom left corner of the grid 63 zusden2 ! temporary scalars 64 #endif 59 zusden, zusden2 ! temporary scalars 65 60 !!--------------------------------------------------------------------- 66 61 … … 117 112 !------------------- 118 113 !!ibug ??? 114 akappa(:,:,:,:) = 0.e0 119 115 wght(:,:,:,:) = 0.e0 120 tmu(:,:) = 0.e0121 #if defined key_lim2_vp122 akappa(:,:,:,:) = 0.e0123 116 alambd(:,:,:,:,:,:) = 0.e0 124 #else 125 tmv(:,:) = 0.e0 126 tmf(:,:) = 0.e0 127 #endif 117 tmu(:,:) = 0.e0 128 118 !!i 129 119 130 #if defined key_lim2_vp 120 131 121 ! metric coefficients for sea ice dynamic 132 122 !---------------------------------------- … … 162 152 CALL lbc_lnk( wght(:,:,2,1), 'I', 1. ) ! but it is never used 163 153 CALL lbc_lnk( wght(:,:,2,2), 'I', 1. ) 164 #else165 ! ! weights (wght)166 DO jj = 2, jpj-1167 DO ji = 2, jpi-1168 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 DO175 END DO176 177 !With EVP, the weights are calculated on 'F' points178 CALL lbc_lnk( wght(:,:,1,1), 'F', 1. ) ! CAUTION: even with the lbc_lnk at ice U-V-point179 CALL lbc_lnk( wght(:,:,1,2), 'F', 1. ) ! the value of wght at jpj is wrong180 CALL lbc_lnk( wght(:,:,2,1), 'F', 1. ) ! but it is never used181 CALL lbc_lnk( wght(:,:,2,2), 'F', 1. )182 183 #endif184 154 185 155 ! Coefficients for divergence of the stress tensor 186 156 !------------------------------------------------- 187 157 188 #if defined key_lim2_vp189 158 DO jj = 2, jpj 190 159 DO ji = 2, jpi ! NO vector opt. … … 254 223 CALL lbc_lnk( alambd(:,:,2,1,1,1), 'I', 1. ) ! 255 224 CALL lbc_lnk( alambd(:,:,2,1,1,2), 'I', 1. ) ! 256 #endif257 225 258 226 … … 265 233 tmu(:,1) = 0.e0 266 234 tmu(1,:) = 0.e0 267 268 #if defined key_lim2_vp269 235 DO jj = 2, jpj ! ice U.V-point: computed from ice T-point mask 270 236 DO ji = 2, jpim1 ! NO vector opt. … … 275 241 !--lateral boundary conditions 276 242 CALL lbc_lnk( tmu(:,:), 'I', 1. ) 277 #else278 tmv(:,1) = 0.e0 !SB279 tmv(1,:) = 0.e0 !SB280 tmf(1,:) = 0.e0281 tmf(:,1) = 0.e0282 DO jj = 1, jpj - 1283 DO ji = 1 , jpi - 1284 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 DO289 END DO290 291 !--lateral boundary conditions292 CALL lbc_lnk( tmu(:,:), 'U', 1. )293 CALL lbc_lnk( tmv(:,:), 'V', 1. )294 CALL lbc_lnk( tmf(:,:), 'F', 1. )295 #endif296 243 297 244 ! unmasked and masked area of T-grid cell -
branches/devmercator2010/NEMO/LIM_SRC_2/limrhg_2.F90
r2076 r2077 9 9 !! " " ! 06-08 (G. Madec) surface module, ice-stress at I-point 10 10 !! " " ! 09-09 (G. Madec) Huge verctor optimisation 11 !! 3.3 ! 09-05 (G.Garric) addition of the lim2_evp case 12 !!---------------------------------------------------------------------- 13 #if defined key_lim2 && defined key_lim2_vp 11 !!---------------------------------------------------------------------- 12 #if defined key_lim2 14 13 !!---------------------------------------------------------------------- 15 14 !! 'key_lim2' LIM 2.0 sea-ice model -
branches/devmercator2010/NEMO/LIM_SRC_2/limrst_2.F90
r2076 r2077 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 case9 8 !!---------------------------------------------------------------------- 10 9 #if defined key_lim2 … … 109 108 CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter, wp) ) 110 109 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 (:,:) ) 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 (:,:) ) 162 156 163 157 IF( iter == nitrst ) THEN … … 224 218 ENDIF 225 219 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 ) 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 ) 268 257 269 258 CALL iom_close( numrir ) -
branches/devmercator2010/NEMO/LIM_SRC_2/limsbc_2.F90
r2076 r2077 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 case10 9 !!---------------------------------------------------------------------- 11 10 #if defined key_lim2 … … 89 88 REAL(wp) :: zfrldu, zfrldv ! lead fraction at U- & V-points 90 89 REAL(wp) :: zutau , zvtau ! lead fraction at U- & V-points 91 !!! REAL(wp) :: zutaui , zvtaui ! lead fraction at U- & V-points92 90 REAL(wp) :: zu_io , zv_io ! 2 components of the ice-ocean velocity 93 91 ! interface 2D --> 3D … … 277 275 DO ji = 2, jpim1 ! NO vector opt. 278 276 ! ... components of ice-ocean stress at U and V-points (from I-point values) 279 #if defined key_lim2_vp280 277 zutau = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) ) 281 278 zvtau = 0.5 * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) ) 282 #else283 zutau = ztio_u(ji,jj)284 zvtau = ztio_v(ji,jj)285 #endif286 279 ! ... open-ocean (lead) fraction at U- & V-points (from T-point values) 287 280 zfrldu = 0.5 * ( frld(ji,jj) + frld(ji+1,jj ) ) -
branches/devmercator2010/NEMO/LIM_SRC_2/limtrp_2.F90
r2076 r2077 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 case70 69 !!--------------------------------------------------------------------- 71 70 INTEGER, INTENT(in) :: kt ! number of iteration … … 108 107 ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions. 109 108 zvbord = 1.0 + ( 1.0 - bound ) 110 #if defined key_lim2_vp111 109 DO jj = 1, jpjm1 112 110 DO ji = 1, jpim1 ! NO vector opt. … … 118 116 CALL lbc_lnk( zui_u, 'U', -1. ) 119 117 CALL lbc_lnk( zvi_v, 'V', -1. ) 120 #else121 zui_u(:,:)=u_ice(:,:)122 zvi_v(:,:)=v_ice(:,:)123 #endif124 118 125 119 ! CFL test for stability -
branches/devmercator2010/NEMO/LIM_SRC_3/limrhg.F90
r2076 r2077 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 cas10 9 !!---------------------------------------------------------------------- 11 #if defined key_lim3 || ( defined key_lim2 && ! defined key_lim2_vp )10 #if defined key_lim3 12 11 !!---------------------------------------------------------------------- 13 12 !! 'key_lim3' LIM3 sea-ice model … … 19 18 USE par_oce 20 19 USE dom_oce 20 USE dom_ice 21 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE ice 24 USE iceini 23 25 USE lbclnk 24 26 USE lib_mpp … … 26 28 USE limitd_me 27 29 USE prtctl ! Print control 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 30 38 31 39 32 IMPLICIT NONE … … 187 180 zresr !: Local error on velocity 188 181 189 #if defined key_lim2 && ! defined key_lim2_vp190 vt_s => hsnm191 vt_i => hicm192 at_i(:,:) = 1. - frld(:,:)193 #endif194 182 ! 195 183 !------------------------------------------------------------------------------! … … 202 190 u_ice2(:,:) = 0.0 ; v_ice1(:,:) = 0.0 203 191 zdd(:,:) = 0.0 ; zdt(:,:) = 0.0 ; zds(:,:) = 0.0 204 #if defined key_lim3 192 205 193 ! Ice strength on T-points 206 194 CALL lim_itd_me_icestrength(ridge_scheme_swi) 207 #endif208 195 209 196 ! Ice mass and temp variables … … 213 200 DO ji = 1 , jpi 214 201 zc1(ji,jj) = tms(ji,jj) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) ) 215 #if defined key_lim3216 202 zpresh(ji,jj) = tms(ji,jj) * strength(ji,jj) / 2. 217 #else218 zpresh(ji,jj) = tms(ji,jj) * 2. * pstar * hicm(ji,jj) * EXP( -c_rhg * frld(ji,jj) )219 #endif220 203 ! tmi = 1 where there is ice or on land 221 204 tmi(ji,jj) = 1.0 - ( 1.0 - MAX( 0.0 , SIGN ( 1.0 , vt_i(ji,jj) - & … … 286 269 / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 287 270 ! 288 ! Mass, coriolis coeff. and currents289 271 u_oce1(ji,jj) = u_oce(ji,jj) 290 272 v_oce2(ji,jj) = v_oce(ji,jj) -
branches/devmercator2010/NEMO/OPA_SRC/DTA/dtasal.F90
r2075 r2077 13 13 USE oce ! ocean dynamics and tracers 14 14 USE dom_oce ! ocean space and time domain 15 USE fldread ! read input fields 15 16 USE in_out_manager ! I/O manager 16 17 USE phycst ! physical constants … … 27 28 !! * Shared module variables 28 29 LOGICAL , PUBLIC, PARAMETER :: lk_dtasal = .TRUE. !: salinity data flag 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 30 s_dta !: salinity data at given time-step 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: s_dta !: salinity data at given time-step 31 31 32 32 !! * Module variables 33 INTEGER :: & 34 numsdt, & !: logical unit for data salinity 35 nsal1, nsal2 ! first and second record used 36 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 37 saldta ! salinity data at two consecutive times 33 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sal ! structure of input SST (file informations, fields read) 38 34 39 35 !! * Substitutions … … 52 48 53 49 SUBROUTINE dta_sal( kt ) 54 !!---------------------------------------------------------------------- 55 !! *** ROUTINE dta_sal *** 56 !! 57 !! ** Purpose : Reads monthly salinity data 58 !! 59 !! ** Method : - Read on unit numsdt the monthly salinity data interpo- 60 !! lated onto the model grid. 61 !! - At each time step, a linear interpolation is applied 62 !! between two monthly values. 63 !! 64 !! History : 65 !! ! 91-03 () Original code 66 !! ! 92-07 (M. Imbard) 67 !! 9.0 ! 02-06 (G. Madec) F90: Free form and module 68 !!---------------------------------------------------------------------- 69 !! * Modules used 70 USE iom 71 72 !! * Arguments 73 INTEGER, INTENT(in) :: kt ! ocean time step 74 75 !! * Local declarations 76 77 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 78 INTEGER :: & 79 imois, iman, i15, ik ! temporary integers 80 # if defined key_tradmp 81 INTEGER :: & 50 !!---------------------------------------------------------------------- 51 !! *** ROUTINE dta_sal *** 52 !! 53 !! ** Purpose : Reads monthly salinity data 54 !! 55 !! ** Method : - Read on unit numsdt the monthly salinity data interpo- 56 !! lated onto the model grid. 57 !! - At each time step, a linear interpolation is applied 58 !! between two monthly values. 59 !! 60 !! History : 61 !! ! 91-03 () Original code 62 !! ! 92-07 (M. Imbard) 63 !! 9.0 ! 02-06 (G. Madec) F90: Free form and module 64 !!---------------------------------------------------------------------- 65 66 !! * Arguments 67 INTEGER, INTENT(in) :: kt ! ocean time step 68 69 !! * Local declarations 70 71 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 72 INTEGER :: & 73 imois, iman, i15, ik ! temporary integers 74 INTEGER :: ierror 75 #if defined key_tradmp 76 INTEGER :: & 82 77 il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 83 # 84 REAL(wp) :: zxy, zl78 #endif 79 REAL(wp) :: zxy, zl 85 80 #if defined key_orca_lev10 86 REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: zsal 87 INTEGER :: ikr, ikw, ikt, jjk 88 REAL(wp) :: zfac 89 #endif 90 REAL(wp), DIMENSION(jpk,2) :: & 81 INTEGER :: ikr, ikw, ikt, jjk 82 REAL(wp) :: zfac 83 #endif 84 REAL(wp), DIMENSION(jpk) :: & 91 85 zsaldta ! auxiliary array for interpolation 92 !!---------------------------------------------------------------------- 93 94 ! 0. Initialization 95 ! ----------------- 96 97 iman = INT( raamo ) 98 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 99 i15 = nday / 16 100 imois = nmonth + i15 - 1 101 IF( imois == 0 ) imois = iman 102 103 ! 1. First call kt=nit000 104 ! ----------------------- 105 106 IF( kt == nit000 ) THEN 107 108 nsal1 = 0 ! initializations 109 IF(lwp) WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 110 CALL iom_open ( 'data_1m_salinity_nomask', numsdt ) 111 112 ENDIF 113 114 115 ! 2. Read monthly file 116 ! ------------------- 117 118 IF( kt == nit000 .OR. imois /= nsal1 ) THEN 119 120 ! 2.1 Calendar computation 121 122 nsal1 = imois ! first file record used 123 nsal2 = nsal1 + 1 ! last file record used 124 nsal1 = MOD( nsal1, iman ) 125 IF( nsal1 == 0 ) nsal1 = iman 126 nsal2 = MOD( nsal2, iman ) 127 IF( nsal2 == 0 ) nsal2 = iman 128 IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1 129 IF(lwp) WRITE(numout,*) 'last record file used nsal2 ', nsal2 130 131 ! 2.3 Read monthly salinity data Levitus 86 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 87 TYPE(FLD_N) :: sn_sal 88 LOGICAL , SAVE :: linit_sal = .FALSE. 89 !!---------------------------------------------------------------------- 90 NAMELIST/namdta_sal/cn_dir,sn_sal 91 92 ! 1. Initialization 93 ! ----------------------- 94 95 IF( kt == nit000 .AND. ( .NOT. linit_sal ) ) THEN 96 97 ! ! set file information 98 cn_dir = './' ! directory in which the model is executed 99 ! ... default values (NB: frequency positive => hours, negative => months) 100 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 101 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 102 sn_sal = FLD_N( 'salinity', -1. , 'vosaline', .false. , .true. , 'monthly' , '' , '' ) 103 104 REWIND ( numnam ) ! ... read in namlist namdta_sal 105 READ( numnam, namdta_sal ) 106 107 IF(lwp) THEN ! control print 108 WRITE(numout,*) 109 WRITE(numout,*) 'dta_sal : Salinity Climatology ' 110 WRITE(numout,*) '~~~~~~~ ' 111 ENDIF 112 ALLOCATE( sf_sal(1), STAT=ierror ) 113 IF( ierror > 0 ) THEN 114 CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' ) ; RETURN 115 ENDIF 116 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk) ) 117 ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 118 119 ! fill sf_sal with sn_sal and control print 120 CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) 121 linit_sal = .TRUE. 122 ENDIF 123 124 125 ! 2. Read monthly file 126 ! ------------------- 127 128 CALL fld_read( kt, 1, sf_sal ) 129 130 IF( lwp .AND. kt==nn_it000 ) THEN 131 WRITE(numout,*) 132 WRITE(numout,*) ' read Levitus salinity ok' 133 WRITE(numout,*) 134 ENDIF 135 136 #if defined key_tradmp 137 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 138 139 ! ! ======================= 140 ! ! ORCA_R2 configuration 141 ! ! ======================= 142 ij0 = 101 ; ij1 = 109 143 ii0 = 141 ; ii1 = 155 144 DO jj = mj0(ij0), mj1(ij1) ! Reduced salinity in the Alboran Sea 145 DO ji = mi0(ii0), mi1(ii1) 146 sf_sal(1)%fnow(ji,jj,13:13) = sf_sal(1)%fnow(ji,jj,13:13) - 0.15 147 sf_sal(1)%fnow(ji,jj,14:15) = sf_sal(1)%fnow(ji,jj,14:15) - 0.25 148 sf_sal(1)%fnow(ji,jj,16:17) = sf_sal(1)%fnow(ji,jj,16:17) - 0.30 149 sf_sal(1)%fnow(ji,jj,18:25) = sf_sal(1)%fnow(ji,jj,18:25) - 0.35 150 END DO 151 END DO 152 153 IF( n_cla == 1 ) THEN 154 ! ! New salinity profile at Gibraltar 155 il0 = 138 ; il1 = 138 156 ij0 = 101 ; ij1 = 102 157 ii0 = 139 ; ii1 = 139 158 DO jl = mi0(il0), mi1(il1) 159 DO jj = mj0(ij0), mj1(ij1) 160 DO ji = mi0(ii0), mi1(ii1) 161 sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:) 162 END DO 163 END DO 164 END DO 165 ! ! New salinity profile at Bab el Mandeb 166 il0 = 164 ; il1 = 164 167 ij0 = 87 ; ij1 = 88 168 ii0 = 161 ; ii1 = 163 169 DO jl = mi0(il0), mi1(il1) 170 DO jj = mj0(ij0), mj1(ij1) 171 DO ji = mi0(ii0), mi1(ii1) 172 sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:) 173 END DO 174 END DO 175 END DO 176 ! 177 ENDIF 178 ! 179 ENDIF 180 #endif 132 181 133 182 #if defined key_orca_lev10 134 if (ln_zps) stop 135 zsal(:,:,:,:) = 0. 136 CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,1),nsal1) 137 CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,2),nsal2) 183 DO jjk = 1, 5 184 s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,1) 185 ENDDO 186 DO jk = 1, jpk-20,10 187 ikr = INT(jk/10) + 1 188 ikw = (ikr-1) *10 + 1 189 ikt = ikw + 5 190 DO jjk=ikt,ikt+9 191 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 192 s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,ikr) + ( sf_sal(1)%fnow(:,:,ikr+1) - sf_sal(1)%fnow(:,:,ikr) ) * zfac 193 END DO 194 END DO 195 DO jjk = jpk-5, jpk 196 s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,jpkdta-1) 197 END DO 198 ! fill the overlap areas 199 CALL lbc_lnk (s_dta(:,:,:),'Z',-999.,'no0') 138 200 #else 139 CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,1),nsal1) 140 CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,2),nsal2) 141 #endif 142 143 IF(lwp) THEN 144 WRITE(numout,*) 145 WRITE(numout,*) ' read Levitus salinity ok' 146 WRITE(numout,*) 147 ENDIF 148 149 #if defined key_tradmp 150 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 201 s_dta(:,:,:)=sf_sal(1)%fnow(:,:,:) 202 #endif 203 204 IF( ln_sco ) THEN 205 DO jj = 1, jpj ! interpolation of salinites 206 DO ji = 1, jpi 207 DO jk = 1, jpk 208 zl=fsdept_0(ji,jj,jk) 209 IF(zl < gdept_0(1) ) zsaldta(jk) = s_dta(ji,jj,1 ) 210 IF(zl > gdept_0(jpk)) zsaldta(jk) = s_dta(ji,jj,jpkm1) 211 DO jkk = 1, jpkm1 212 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 213 zsaldta(jk) = s_dta(ji,jj,jkk) & 214 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 215 & *(s_dta(ji,jj,jkk+1) - s_dta(ji,jj,jkk)) 216 ENDIF 217 END DO 218 END DO 219 DO jk = 1, jpkm1 220 s_dta(ji,jj,jk) = zsaldta(jk) 221 END DO 222 s_dta(ji,jj,jpk) = 0.0 223 END DO 224 END DO 151 225 152 ! ! ======================= 153 ! ! ORCA_R2 configuration 154 ! ! ======================= 155 ij0 = 101 ; ij1 = 109 156 ii0 = 141 ; ii1 = 155 157 DO jj = mj0(ij0), mj1(ij1) ! Reduced salinity in the Alboran Sea 158 DO ji = mi0(ii0), mi1(ii1) 159 #if defined key_orca_lev10 160 zsal (ji,jj,13:13,:) = zsal (ji,jj,13:13,:) - 0.15 161 zsal (ji,jj,14:15,:) = zsal (ji,jj,14:15,:) - 0.25 162 zsal (ji,jj,16:17,:) = zsal (ji,jj,16:17,:) - 0.30 163 zsal (ji,jj,18:25,:) = zsal (ji,jj,18:25,:) - 0.35 164 #else 165 saldta(ji,jj,13:13,:) = saldta(ji,jj,13:13,:) - 0.15 166 saldta(ji,jj,14:15,:) = saldta(ji,jj,14:15,:) - 0.25 167 saldta(ji,jj,16:17,:) = saldta(ji,jj,16:17,:) - 0.30 168 saldta(ji,jj,18:25,:) = saldta(ji,jj,18:25,:) - 0.35 169 #endif 170 END DO 171 END DO 172 173 IF( n_cla == 1 ) THEN 174 ! ! New salinity profile at Gibraltar 175 il0 = 138 ; il1 = 138 176 ij0 = 101 ; ij1 = 102 177 ii0 = 139 ; ii1 = 139 178 DO jl = mi0(il0), mi1(il1) 179 DO jj = mj0(ij0), mj1(ij1) 180 DO ji = mi0(ii0), mi1(ii1) 181 #if defined key_orca_lev10 182 zsal (ji,jj,:,:) = zsal (jl,jj,:,:) 183 #else 184 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 185 #endif 186 END DO 187 END DO 188 END DO 189 ! ! New salinity profile at Bab el Mandeb 190 il0 = 164 ; il1 = 164 191 ij0 = 87 ; ij1 = 88 192 ii0 = 161 ; ii1 = 163 193 DO jl = mi0(il0), mi1(il1) 194 DO jj = mj0(ij0), mj1(ij1) 195 DO ji = mi0(ii0), mi1(ii1) 196 #if defined key_orca_lev10 197 zsal (ji,jj,:,:) = zsal (jl,jj,:,:) 198 #else 199 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 200 #endif 201 END DO 202 END DO 203 END DO 204 ! 205 ENDIF 206 ! 207 ENDIF 208 #endif 209 210 #if defined key_orca_lev10 211 ! interpolate from 31 to 301 level the zsal field result in saldta 212 DO jl = 1, 2 213 DO jjk = 1, 5 214 saldta(:,:,jjk,jl) = zsal(:,:,1,jl) 215 ENDDO 216 DO jk = 1, jpk - 20, 10 217 ikr = INT( jk / 10 ) + 1 218 ikw = (ikr-1) * 10 + 1 219 ikt = ikw + 5 220 DO jjk = ikt , ikt + 9 221 zfac = ( gdept_0(jjk) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 222 saldta(:,:,jjk,jl) = zsal(:,:,ikr,jl) + ( zsal(:,:,ikr+1,jl) - zsal(:,:,ikr,jl) ) * zfac 223 END DO 224 END DO 225 DO jjk = jpk-5, jpk 226 saldta(:,:,jjk,jl) = zsal(:,:,jpkdta-1,jl) 227 END DO 228 ! fill the overlap areas 229 CALL lbc_lnk (saldta(:,:,:,jl),'Z',-999.,'no0') 230 END DO 231 232 #endif 233 234 IF( ln_sco ) THEN 235 DO jl = 1, 2 236 DO jj = 1, jpj ! interpolation of salinites 237 DO ji = 1, jpi 238 DO jk = 1, jpk 239 zl=fsdept_0(ji,jj,jk) 240 IF(zl < gdept_0(1)) zsaldta(jk,jl) = saldta(ji,jj,1,jl) 241 IF(zl > gdept_0(jpk)) zsaldta(jk,jl) = saldta(ji,jj,jpkm1,jl) 242 DO jkk = 1, jpkm1 243 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 244 zsaldta(jk,jl) = saldta(ji,jj,jkk,jl) & 245 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 246 & *(saldta(ji,jj,jkk+1,jl) - saldta(ji,jj,jkk,jl)) 247 ENDIF 248 END DO 249 END DO 250 DO jk = 1, jpkm1 251 saldta(ji,jj,jk,jl) = zsaldta(jk,jl) 252 END DO 253 saldta(ji,jj,jpk,jl) = 0.0 254 END DO 255 END DO 256 END DO 257 258 IF(lwp) WRITE(numout,*) 259 IF(lwp) WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 260 IF(lwp) WRITE(numout,*) 261 262 ELSE 263 ! ! Mask 264 DO jl = 1, 2 265 saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:) 266 saldta(:,:,jpk,jl) = 0. 267 IF( ln_zps ) THEN ! z-coord. partial steps 268 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 269 DO ji = 1, jpi 270 ik = mbathy(ji,jj) - 1 271 IF( ik > 2 ) THEN 272 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 273 saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl) 274 ENDIF 275 END DO 276 END DO 277 ENDIF 278 END DO 279 ENDIF 280 281 282 IF(lwp) THEN 283 WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2 284 WRITE(numout,*) 285 WRITE(numout,*) ' Levitus month = ',nsal1,' level = 1' 286 CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 287 WRITE(numout,*) ' Levitus month = ',nsal1,' level = ',jpk/2 288 CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 289 WRITE(numout,*) ' Levitus month = ',nsal1,' level = ',jpkm1 290 CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 291 ENDIF 292 ENDIF 293 294 295 ! 3. At every time step compute salinity data 296 ! ------------------------------------------- 297 298 zxy = FLOAT(nday + 15 - 30*i15)/30. 299 s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2) 300 301 ! Close the file 302 ! -------------- 303 304 IF( kt == nitend ) CALL iom_close (numsdt) 226 IF( lwp .AND. kt==nn_it000 ) THEN 227 WRITE(numout,*) 228 WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 229 WRITE(numout,*) 230 ENDIF 231 232 ELSE 233 ! ! Mask 234 s_dta(:,:,:) = s_dta(:,:,:) * tmask(:,:,:) 235 s_dta(:,:,jpk) = 0. 236 IF( ln_zps ) THEN ! z-coord. partial steps 237 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 238 DO ji = 1, jpi 239 ik = mbathy(ji,jj) - 1 240 IF( ik > 2 ) THEN 241 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 242 s_dta(ji,jj,ik) = (1.-zl) * s_dta(ji,jj,ik) + zl * s_dta(ji,jj,ik-1) 243 ENDIF 244 END DO 245 END DO 246 ENDIF 247 ENDIF 248 249 IF( lwp .AND. kt==nn_it000 ) THEN 250 WRITE(numout,*)' salinity Levitus ' 251 WRITE(numout,*) 252 WRITE(numout,*)' level = 1' 253 CALL prihre(s_dta(:,:,1), jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 254 WRITE(numout,*)' level = ',jpk/2 255 CALL prihre(s_dta(:,:,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 256 WRITE(numout,*) ' level = ',jpkm1 257 CALL prihre(s_dta(:,:,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 258 ENDIF 305 259 306 260 END SUBROUTINE dta_sal -
branches/devmercator2010/NEMO/OPA_SRC/DTA/dtatem.F90
r2075 r2077 13 13 USE oce ! ocean dynamics and tracers 14 14 USE dom_oce ! ocean space and time domain 15 USE fldread ! read input fields 15 16 USE in_out_manager ! I/O manager 16 17 USE phycst ! physical constants … … 26 27 !! * Shared module variables 27 28 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. !: temperature data flag 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 29 t_dta !: temperature data at given time-step 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: t_dta !: temperature data at given time-step 30 30 31 31 !! * Module variables 32 INTEGER :: & 33 numtdt, & !: logical unit for data temperature 34 ntem1, ntem2 ! first and second record used 35 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 36 temdta ! temperature data at two consecutive times 32 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tem ! structure of input SST (file informations, fields read) 37 33 38 34 !! * Substitutions … … 73 69 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module 74 70 !!---------------------------------------------------------------------- 75 !! * Modules used76 USE iom77 78 71 !! * Arguments 79 72 INTEGER, INTENT( in ) :: kt ! ocean time-step 80 73 81 74 !! * Local declarations 82 INTEGER :: ji, jj, j l, jk, jkk ! dummy loop indicies75 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 83 76 INTEGER :: & 84 imois, iman, i15 , ik ! temporary integers 85 # if defined key_tradmp 77 imois, iman, i15 , ik ! temporary integers 78 INTEGER :: ierror 79 #if defined key_tradmp 86 80 INTEGER :: & 87 81 il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 88 # 82 #endif 89 83 REAL(wp) :: zxy, zl 90 84 #if defined key_orca_lev10 91 REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem85 !!!REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 92 86 INTEGER :: ikr, ikw, ikt, jjk 93 87 REAL(wp) :: zfac 94 88 #endif 95 REAL(wp), DIMENSION(jpk ,2) :: &89 REAL(wp), DIMENSION(jpk) :: & 96 90 ztemdta ! auxiliary array for interpolation 91 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 92 TYPE(FLD_N) :: sn_tem 93 LOGICAL , SAVE :: linit_tem = .FALSE. 97 94 !!---------------------------------------------------------------------- 98 99 ! 0. Initialization 100 ! ----------------- 101 102 iman = INT( raamo ) 103 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 104 i15 = nday / 16 105 imois = nmonth + i15 - 1 106 IF( imois == 0 ) imois = iman 107 108 ! 1. First call kt=nit000 95 NAMELIST/namdta_tem/cn_dir,sn_tem 96 97 ! 1. Initialization 109 98 ! ----------------------- 110 99 111 IF( kt == nit000 ) THEN 112 113 ntem1= 0 ! initializations 114 IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' 115 CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt ) 116 117 ENDIF 118 100 IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN 101 102 ! ! set file information 103 cn_dir = './' ! directory in which the model is executed 104 ! ... default values (NB: frequency positive => hours, negative => months) 105 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 106 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 107 sn_tem = FLD_N( 'temperature', -1. , 'votemper', .false. , .true. , 'yearly' , '' , '' ) 108 109 REWIND( numnam ) ! ... read in namlist namdta_tem 110 READ( numnam, namdta_tem ) 111 112 IF(lwp) THEN ! control print 113 WRITE(numout,*) 114 WRITE(numout,*) 'dta_tem : Temperature Climatology ' 115 WRITE(numout,*) '~~~~~~~ ' 116 ENDIF 117 ALLOCATE( sf_tem(1), STAT=ierror ) 118 IF( ierror > 0 ) THEN 119 CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' ) ; RETURN 120 ENDIF 121 122 #if defined key_orca_lev10 123 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta) ) 124 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) ) 125 #else 126 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk) ) 127 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 128 #endif 129 ! fill sf_tem with sn_tem and control print 130 CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 131 linit_tem = .TRUE. 132 133 ENDIF 119 134 120 135 ! 2. Read monthly file 121 136 ! ------------------- 122 123 IF( kt == nit000 .OR. imois /= ntem1 ) THEN 124 125 ! Calendar computation 126 127 ntem1 = imois ! first file record used 128 ntem2 = ntem1 + 1 ! last file record used 129 ntem1 = MOD( ntem1, iman ) 130 IF( ntem1 == 0 ) ntem1 = iman 131 ntem2 = MOD( ntem2, iman ) 132 IF( ntem2 == 0 ) ntem2 = iman 133 IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 134 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 135 136 ! Read monthly temperature data Levitus 137 138 #if defined key_orca_lev10 139 if (ln_zps) stop 140 ztem(:,:,:,:) = 0. 141 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1) 142 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2) 143 #else 144 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1) 145 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2) 146 #endif 147 148 IF(lwp) WRITE(numout,*) 149 IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 150 IF(lwp) WRITE(numout,*) 137 138 CALL fld_read( kt, 1, sf_tem ) 139 140 IF( lwp .AND. kt==nn_it000 )THEN 141 WRITE(numout,*) 142 WRITE(numout,*) ' read Levitus temperature ok' 143 WRITE(numout,*) 144 ENDIF 151 145 152 146 #if defined key_tradmp 153 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 154 155 ! ! ======================= 156 ! ! ORCA_R2 configuration 157 ! ! ======================= 158 ij0 = 101 ; ij1 = 109 159 ii0 = 141 ; ii1 = 155 160 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 161 DO ji = mi0(ii0), mi1(ii1) 162 #if defined key_orca_lev10 163 ztem( ji,jj, 13:13 ,:) = ztem (ji,jj, 13:13 ,:) - 0.20 164 ztem (ji,jj, 14:15 ,:) = ztem (ji,jj, 14:15 ,:) - 0.35 165 ztem (ji,jj, 16:25 ,:) = ztem (ji,jj, 16:25 ,:) - 0.40 147 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 148 149 ! ! ======================= 150 ! ! ORCA_R2 configuration 151 ! ! ======================= 152 ij0 = 101 ; ij1 = 109 153 ii0 = 141 ; ii1 = 155 154 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 155 DO ji = mi0(ii0), mi1(ii1) 156 sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20 157 sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35 158 sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40 159 END DO 160 END DO 161 162 IF( n_cla == 1 ) THEN 163 ! ! New temperature profile at Gibraltar 164 il0 = 138 ; il1 = 138 165 ij0 = 101 ; ij1 = 102 166 ii0 = 139 ; ii1 = 139 167 DO jl = mi0(il0), mi1(il1) 168 DO jj = mj0(ij0), mj1(ij1) 169 DO ji = mi0(ii0), mi1(ii1) 170 sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 171 END DO 172 END DO 173 END DO 174 ! ! New temperature profile at Bab el Mandeb 175 il0 = 164 ; il1 = 164 176 ij0 = 87 ; ij1 = 88 177 ii0 = 161 ; ii1 = 163 178 DO jl = mi0(il0), mi1(il1) 179 DO jj = mj0(ij0), mj1(ij1) 180 DO ji = mi0(ii0), mi1(ii1) 181 sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 182 END DO 183 END DO 184 END DO 185 ! 186 ELSE 187 ! ! Reduced temperature at Red Sea 188 ij0 = 87 ; ij1 = 96 189 ii0 = 148 ; ii1 = 160 190 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0 191 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5 192 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0 193 ENDIF 194 ! 195 ENDIF 196 #endif 197 198 #if defined key_orca_lev10 199 DO jjk = 1, 5 200 t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,1) 201 END DO 202 DO jk = 1, jpk-20,10 203 ik = jk+5 204 ikr = INT(jk/10) + 1 205 ikw = (ikr-1) *10 + 1 206 ikt = ikw + 5 207 DO jjk=ikt,ikt+9 208 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 209 t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,ikr) + ( sf_tem(1)%fnow(:,:,ikr+1) - sf_tem(1)%fnow(:,:,ikr) ) * zfac 210 END DO 211 END DO 212 DO jjk = jpk-5, jpk 213 t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,jpkdta-1) 214 END DO 215 ! fill the overlap areas 216 CALL lbc_lnk (t_dta(:,:,:),'Z',-999.,'no0') 166 217 #else 167 temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 168 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 169 temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 170 #endif 171 END DO 172 END DO 173 174 IF( n_cla == 1 ) THEN 175 ! ! New temperature profile at Gibraltar 176 il0 = 138 ; il1 = 138 177 ij0 = 101 ; ij1 = 102 178 ii0 = 139 ; ii1 = 139 179 DO jl = mi0(il0), mi1(il1) 180 DO jj = mj0(ij0), mj1(ij1) 181 DO ji = mi0(ii0), mi1(ii1) 182 #if defined key_orca_lev10 183 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 184 #else 185 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 186 #endif 187 END DO 218 t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 219 #endif 220 221 IF( ln_sco ) THEN 222 DO jj = 1, jpj ! interpolation of temperatures 223 DO ji = 1, jpi 224 DO jk = 1, jpk 225 zl=fsdept_0(ji,jj,jk) 226 IF(zl < gdept_0(1)) ztemdta(jk) = t_dta(ji,jj,1) 227 IF(zl > gdept_0(jpk)) ztemdta(jk) = t_dta(ji,jj,jpkm1) 228 DO jkk = 1, jpkm1 229 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 230 ztemdta(jk) = t_dta(ji,jj,jkk) & 231 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 232 & * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk)) 233 ENDIF 188 234 END DO 189 235 END DO 190 ! ! New temperature profile at Bab el Mandeb 191 il0 = 164 ; il1 = 164 192 ij0 = 87 ; ij1 = 88 193 ii0 = 161 ; ii1 = 163 194 DO jl = mi0(il0), mi1(il1) 195 DO jj = mj0(ij0), mj1(ij1) 196 DO ji = mi0(ii0), mi1(ii1) 197 #if defined key_orca_lev10 198 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 199 #else 200 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 201 #endif 202 END DO 203 END DO 204 END DO 205 ! 206 ELSE 207 ! ! Reduced temperature at Red Sea 208 ij0 = 87 ; ij1 = 96 209 ii0 = 148 ; ii1 = 160 210 #if defined key_orca_lev10 211 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 212 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 213 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 214 #else 215 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 216 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 217 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 218 #endif 219 ENDIF 220 ! 221 ENDIF 222 #endif 223 224 #if defined key_orca_lev10 225 ! interpolate from 31 to 301 level the ztem field result in temdta 226 DO jl = 1, 2 227 DO jjk = 1, 5 228 temdta(:,:,jjk,jl) = ztem(:,:,1,jl) 229 END DO 230 DO jk = 1, jpk-20,10 231 ik = jk+5 232 ikr = INT(jk/10) + 1 233 ikw = (ikr-1) *10 + 1 234 ikt = ikw + 5 235 DO jjk=ikt,ikt+9 236 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 237 temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac 238 END DO 239 END DO 240 DO jjk = jpk-5, jpk 241 temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl) 242 END DO 243 ! fill the overlap areas 244 CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0') 245 END DO 246 #endif 247 248 IF( ln_sco ) THEN 249 DO jl = 1, 2 250 DO jj = 1, jpj ! interpolation of temperatures 251 DO ji = 1, jpi 252 DO jk = 1, jpk 253 zl=fsdept_0(ji,jj,jk) 254 IF(zl < gdept_0(1)) ztemdta(jk,jl) = temdta(ji,jj,1,jl) 255 IF(zl > gdept_0(jpk)) ztemdta(jk,jl) = temdta(ji,jj,jpkm1,jl) 256 DO jkk = 1, jpkm1 257 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 258 ztemdta(jk,jl) = temdta(ji,jj,jkk,jl) & 259 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 260 & *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 261 ENDIF 262 END DO 263 END DO 264 DO jk = 1, jpkm1 265 temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 266 END DO 267 temdta(ji,jj,jpk,jl) = 0.0 268 END DO 269 END DO 270 END DO 271 272 IF(lwp) WRITE(numout,*) 273 IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 274 IF(lwp) WRITE(numout,*) 275 276 ELSE 277 278 ! ! Mask 279 DO jl = 1, 2 280 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 281 temdta(:,:,jpk,jl) = 0. 282 IF( ln_zps ) THEN ! z-coord. with partial steps 283 DO jj = 1, jpj ! interpolation of temperature at the last level 284 DO ji = 1, jpi 285 ik = mbathy(ji,jj) - 1 286 IF( ik > 2 ) THEN 287 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 288 temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 289 ENDIF 290 END DO 291 END DO 292 ENDIF 293 END DO 294 295 ENDIF 296 297 IF(lwp) THEN 298 WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 236 DO jk = 1, jpkm1 237 t_dta(ji,jj,jk) = ztemdta(jk) 238 END DO 239 t_dta(ji,jj,jpk) = 0.0 240 END DO 241 END DO 242 243 IF( lwp .AND. kt==nn_it000 )THEN 299 244 WRITE(numout,*) 300 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' 301 CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 302 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 303 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 304 WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 305 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 306 ENDIF 307 ENDIF 308 309 310 ! 2. At every time step compute temperature data 311 ! ---------------------------------------------- 312 313 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 314 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 315 316 ! Close the file 317 ! -------------- 318 319 IF( kt == nitend ) CALL iom_close (numtdt) 320 321 END SUBROUTINE dta_tem 245 WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 246 WRITE(numout,*) 247 ENDIF 248 249 ELSE 250 ! ! Mask 251 t_dta(:,:,: ) = t_dta(:,:,:) * tmask(:,:,:) 252 t_dta(:,:,jpk) = 0. 253 IF( ln_zps ) THEN ! z-coord. with partial steps 254 DO jj = 1, jpj ! interpolation of temperature at the last level 255 DO ji = 1, jpi 256 ik = mbathy(ji,jj) - 1 257 IF( ik > 2 ) THEN 258 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 259 t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1) 260 ENDIF 261 END DO 262 END DO 263 ENDIF 264 265 ENDIF 266 267 IF( lwp .AND. kt==nn_it000 ) THEN 268 WRITE(numout,*) ' temperature Levitus ' 269 WRITE(numout,*) 270 WRITE(numout,*)' level = 1' 271 CALL prihre( t_dta(:,:,1 ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 272 WRITE(numout,*)' level = ', jpk/2 273 CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 274 WRITE(numout,*)' level = ', jpkm1 275 CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 276 ENDIF 277 278 END SUBROUTINE dta_tem 322 279 323 280 #else -
branches/devmercator2010/NEMO/OPA_SRC/SBC/fldread.F90
r2076 r2077 48 48 INTEGER , DIMENSION(2) :: nrec_b ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 49 49 INTEGER , DIMENSION(2) :: nrec_a ! after record (1: index, 2: second since Jan. 1st 00h of nit000 year) 50 REAL(wp) , ALLOCATABLE, DIMENSION(:,: ) :: fnow! input fields interpolated to now time step51 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,: ) :: fdta! 2 consecutive record of input fields50 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) :: fnow ! input fields interpolated to now time step 51 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) :: fdta ! 2 consecutive record of input fields 52 52 CHARACTER(len = 256) :: wgtname ! current name of the NetCDF weight file acting as a key 53 53 ! into the WGTLIST structure … … 78 78 INTEGER, DIMENSION(:,:,:), POINTER :: data_jpj ! array of source integers 79 79 REAL(wp), DIMENSION(:,:,:), POINTER :: data_wgt ! array of weights on model grid 80 REAL(wp), DIMENSION(:,: ), POINTER:: fly_dta ! array of values on input grid81 REAL(wp), DIMENSION(:,: ), POINTER:: col2 ! temporary array for reading in columns80 REAL(wp), DIMENSION(:,:,:), POINTER :: fly_dta ! array of values on input grid 81 REAL(wp), DIMENSION(:,:,:), POINTER :: col2 ! temporary array for reading in columns 82 82 END TYPE WGT 83 83 … … 120 120 121 121 INTEGER :: jf ! dummy indices 122 INTEGER :: jk ! dummy indices 123 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 122 124 INTEGER :: kw ! index into wgts array 123 125 INTEGER :: ireclast ! last record to be read in the current year file … … 143 145 IF( sd(jf)%ln_tint ) THEN ! time interpolation: swap before record field 144 146 !CDIR COLLAPSE 145 sd(jf)%fdta(:,:, 1) = sd(jf)%fdta(:,:,2)146 sd(jf)%rotn(1) = sd(jf)%rotn(2)147 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 148 sd(jf)%rotn(1) = sd(jf)%rotn(2) 147 149 ENDIF 148 150 … … 157 159 158 160 ! last record to be read in the current file 159 IF( sd(jf)%nfreqh == -1 ) THEN ; ireclast = 12 161 IF( sd(jf)%nfreqh == -1 ) THEN 162 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 1 163 ELSE ; ireclast = 12 164 ENDIF 160 165 ELSE 161 166 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh … … 204 209 IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 205 210 CALL wgt_list( sd(jf), kw ) 206 CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 211 ipk = SIZE(sd(jf)%fdta,3) 212 CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 207 213 ELSE 208 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 214 SELECT CASE( SIZE(sd(jf)%fdta,3) ) 215 CASE(1) 216 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 217 CASE(jpk) 218 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 219 END SELECT 209 220 ENDIF 210 221 sd(jf)%rotn(2) = .FALSE. … … 245 256 utmp(:,:) = 0.0 246 257 vtmp(:,:) = 0.0 247 CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) ) 248 CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) ) 249 sd(jf)%fdta(:,:,nf) = utmp(:,:) 250 sd(kf)%fdta(:,:,nf) = vtmp(:,:) 258 ! 259 ipk = SIZE( sd(kf)%fdta(:,:,:,nf) ,3 ) 260 DO jk = 1,ipk 261 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 262 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 263 sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 264 sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 265 END DO 266 ! 251 267 sd(jf)%rotn(nf) = .TRUE. 252 268 sd(kf)%rotn(nf) = .TRUE. … … 280 296 ztintb = 1. - ztinta 281 297 !CDIR COLLAPSE 282 sd(jf)%fnow(:,: ) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2)298 sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 283 299 ELSE 284 300 IF(lwp .AND. kt - nit000 <= 100 ) THEN … … 288 304 ENDIF 289 305 !CDIR COLLAPSE 290 sd(jf)%fnow(:,: ) = sd(jf)%fdta(:,:,2) ! piecewise constant field306 sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2) ! piecewise constant field 291 307 292 308 ENDIF … … 320 336 INTEGER :: inrec ! number of record existing for this variable 321 337 INTEGER :: kwgt 338 INTEGER :: jk !vertical loop variable 339 INTEGER :: ipk !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 322 340 CHARACTER(LEN=1000) :: clfmt ! write format 323 341 !!--------------------------------------------------------------------- … … 339 357 IF( sdjf%cltype == 'monthly' ) THEN ! monthly file 340 358 sdjf%nrec_b(1) = 1 ! force to read the unique record 341 llprevmth = . NOT. sdjf%ln_clim! use previous month file?359 llprevmth = .TRUE. ! use previous month file? 342 360 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 343 361 ELSE ! yearly file … … 366 384 & nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)), & 367 385 & nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 368 386 369 387 ! if previous year/month/day file does not exist, we switch to the current year/month/day 370 388 IF( llprev .AND. sdjf%num == 0 ) THEN … … 384 402 385 403 ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 404 386 405 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 387 406 CALL wgt_list( sdjf, kwgt ) 388 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 407 ipk = SIZE(sdjf%fdta,3) 408 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 389 409 ELSE 390 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 410 SELECT CASE ( SIZE(sdjf%fdta,3) ) 411 CASE(1) 412 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 413 CASE(jpk) 414 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 415 END SELECT 391 416 ENDIF 392 417 sdjf%rotn(2) = .FALSE. … … 399 424 ENDIF 400 425 426 401 427 IF( sdjf%num == 0 ) CALL fld_clopn( sdjf, nyear, nmonth, nday ) ! make sure current year/month/day file is opened 402 428 403 429 sdjf%nswap_sec = nsec_year + nsec1jan000 - 1 ! force read/update the after data in the following part of fld_read 404 430 405 431 END SUBROUTINE fld_init 406 432 … … 436 462 ! forcing record : nmonth 437 463 ! 438 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 464 ztmp = 0.e0 465 IF( REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) .GT. 0.5 ) ztmp = 1.0 439 466 ELSE 440 467 ztmp = 0.e0 … … 446 473 ENDIF 447 474 448 sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define after record number and time 449 irec = irec - 1 ! move back to previous record 450 sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define before record number and time 475 IF( sdjf%cltype == 'monthly' ) THEN 476 477 sdjf%nrec_b(:) = (/ 0, nmonth_half(irec - 1 ) + nsec1jan000 /) 478 sdjf%nrec_a(:) = (/ 1, nmonth_half(irec ) + nsec1jan000 /) 479 480 IF( ztmp == 1. ) THEN 481 sdjf%nrec_b(1) = 1 482 sdjf%nrec_a(1) = 2 483 ENDIF 484 485 ELSE 486 487 sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define after record number and time 488 irec = irec - 1 ! move back to previous record 489 sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define before record number and time 490 491 ENDIF 451 492 ! 452 493 ELSE ! higher frequency mean (in hours) … … 534 575 IF( sdjf%cltype /= 'yearly' ) WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 535 576 IF( sdjf%cltype == 'daily' ) WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 577 ELSE 578 ! build the new filename if climatological data 579 IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a,"_m" ,i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month 536 580 ENDIF 537 581 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) … … 564 608 sdf(jf)%ln_tint = sdf_n(jf)%ln_tint 565 609 sdf(jf)%ln_clim = sdf_n(jf)%ln_clim 566 IF( sdf(jf)%nfreqh == -1. ) THEN ; sdf(jf)%cltype = 'yearly' 567 ELSE ; sdf(jf)%cltype = sdf_n(jf)%cltype 568 ENDIF 610 sdf(jf)%cltype = sdf_n(jf)%cltype 569 611 sdf(jf)%wgtname = " " 570 612 IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 ) sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) … … 684 726 INTEGER :: inum ! temporary logical unit 685 727 INTEGER :: id ! temporary variable id 728 INTEGER :: ipk ! temporary vertical dimension 686 729 CHARACTER (len=5) :: aname 687 730 INTEGER , DIMENSION(3) :: ddims … … 848 891 ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration. 849 892 ! a more robust solution will be given in next release 850 ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) ) 851 IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) ) 893 ipk = SIZE(sd%fdta,3) 894 ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 895 IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) 852 896 853 897 nxt_wgt = nxt_wgt + 1 … … 859 903 END SUBROUTINE fld_weight 860 904 861 SUBROUTINE fld_interp(num, clvar, kw, dta, nrec)905 SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec) 862 906 !!--------------------------------------------------------------------- 863 907 !! *** ROUTINE fld_interp *** … … 868 912 !! ** Method : 869 913 !!---------------------------------------------------------------------- 870 INTEGER, INTENT(in) :: num ! stream number 871 CHARACTER(LEN=*), INTENT(in) :: clvar ! variable name 872 INTEGER, INTENT(in) :: kw ! weights number 873 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: dta ! output field on model grid 874 INTEGER, INTENT(in) :: nrec ! record number to read (ie time slice) 914 INTEGER, INTENT(in) :: num ! stream number 915 CHARACTER(LEN=*), INTENT(in) :: clvar ! variable name 916 INTEGER, INTENT(in) :: kw ! weights number 917 INTEGER, INTENT(in) :: kk ! vertical dimension of kk 918 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kk) :: dta ! output field on model grid 919 INTEGER, INTENT(in) :: nrec ! record number to read (ie time slice) 875 920 !! 876 INTEGER, DIMENSION( 2):: rec1,recn ! temporary arrays for start and length877 INTEGER :: jk, jn, jm ! loop counters878 INTEGER :: ni, nj ! lengths879 INTEGER :: jpimin,jpiwid ! temporary indices880 INTEGER :: jpjmin,jpjwid ! temporary indices881 INTEGER :: jpi1,jpi2,jpj1,jpj2 ! temporary indices921 INTEGER, DIMENSION(3) :: rec1,recn ! temporary arrays for start and length 922 INTEGER :: jk, jn, jm ! loop counters 923 INTEGER :: ni, nj ! lengths 924 INTEGER :: jpimin,jpiwid ! temporary indices 925 INTEGER :: jpjmin,jpjwid ! temporary indices 926 INTEGER :: jpi1,jpi2,jpj1,jpj2 ! temporary indices 882 927 !!---------------------------------------------------------------------- 883 928 ! … … 897 942 rec1(1) = MAX( jpimin-1, 1 ) 898 943 rec1(2) = MAX( jpjmin-1, 1 ) 944 rec1(3) = 1 899 945 recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 ) 900 946 recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 947 recn(3) = kk 901 948 902 949 !! where we need to read it to … … 906 953 jpj2 = jpj1 + recn(2) - 1 907 954 908 ref_wgts(kw)%fly_dta(:,:) = 0.0 909 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn) 955 ref_wgts(kw)%fly_dta(:,:,:) = 0.0 956 SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 957 CASE(1) 958 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 959 CASE(jpk) 960 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 961 END SELECT 910 962 911 963 !! first four weights common to both bilinear and bicubic 912 964 !! note that we have to offset by 1 into fly_dta array because of halo 913 dta(:,: ) = 0.0965 dta(:,:,:) = 0.0 914 966 DO jk = 1,4 915 DO jn = 1, jpj916 DO jm = 1, jpi967 DO jn = 1, nlcj 968 DO jm = 1,nlci 917 969 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 918 970 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 919 dta(jm,jn ) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1)971 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,jk) 920 972 END DO 921 973 END DO … … 926 978 !! fix up halo points that we couldnt read from file 927 979 IF( jpi1 == 2 ) THEN 928 ref_wgts(kw)%fly_dta(jpi1-1,: ) = ref_wgts(kw)%fly_dta(jpi1,:)980 ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 929 981 ENDIF 930 982 IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 931 ref_wgts(kw)%fly_dta(jpi2+1,: ) = ref_wgts(kw)%fly_dta(jpi2,:)983 ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 932 984 ENDIF 933 985 IF( jpj1 == 2 ) THEN 934 ref_wgts(kw)%fly_dta(:,jpj1-1 ) = ref_wgts(kw)%fly_dta(:,jpj1)986 ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 935 987 ENDIF 936 988 IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN 937 ref_wgts(kw)%fly_dta(:,jpj2+1 ) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1)989 ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 938 990 ENDIF 939 991 … … 948 1000 IF( jpi1 == 2 ) THEN 949 1001 rec1(1) = ref_wgts(kw)%ddims(1) - 1 950 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 951 ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2) 1002 SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 1003 CASE(1) 1004 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 1005 CASE(jpk) 1006 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 1007 END SELECT 1008 ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2,:) 952 1009 ENDIF 953 1010 IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 954 1011 rec1(1) = 1 955 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 956 ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2) 1012 SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 1013 CASE(1) 1014 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 1015 CASE(jpk) 1016 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 1017 END SELECT 1018 ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2,:) 957 1019 ENDIF 958 1020 ENDIF … … 960 1022 ! gradient in the i direction 961 1023 DO jk = 1,4 962 DO jn = 1, jpj963 DO jm = 1, jpi1024 DO jn = 1, nlcj 1025 DO jm = 1,nlci 964 1026 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 965 1027 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 966 dta(jm,jn ) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 * &967 (ref_wgts(kw)%fly_dta(ni+2,nj+1 ) - ref_wgts(kw)%fly_dta(ni,nj+1))1028 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 * & 1029 (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:)) 968 1030 END DO 969 1031 END DO … … 972 1034 ! gradient in the j direction 973 1035 DO jk = 1,4 974 DO jn = 1, jpj975 DO jm = 1, jpi1036 DO jn = 1, nlcj 1037 DO jm = 1,nlci 976 1038 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 977 1039 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 978 dta(jm,jn ) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 * &979 (ref_wgts(kw)%fly_dta(ni+1,nj+2 ) - ref_wgts(kw)%fly_dta(ni+1,nj))1040 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 * & 1041 (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:)) 980 1042 END DO 981 1043 END DO … … 988 1050 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 989 1051 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 990 dta(jm,jn ) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( &991 (ref_wgts(kw)%fly_dta(ni+2,nj+2 ) - ref_wgts(kw)%fly_dta(ni ,nj+2)) - &992 (ref_wgts(kw)%fly_dta(ni+2,nj ) - ref_wgts(kw)%fly_dta(ni ,nj)))1052 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 1053 (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni ,nj+2,:)) - & 1054 (ref_wgts(kw)%fly_dta(ni+2,nj ,:) - ref_wgts(kw)%fly_dta(ni ,nj ,:))) 993 1055 END DO 994 1056 END DO -
branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r2075 r2077 162 162 163 163 DO ifpr= 1, jpfld 164 ALLOCATE( sf(ifpr)%fnow(jpi,jpj ) )165 ALLOCATE( sf(ifpr)%fdta(jpi,jpj, 2) )164 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 165 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 166 166 END DO 167 167 … … 178 178 ! 179 179 #if defined key_lim3 180 tatm_ice(:,:) = sf(jp_tair)%fnow(:,: ) !RB ugly patch180 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) !RB ugly patch 181 181 #endif 182 182 ! … … 272 272 DO jj = 1 , jpj 273 273 DO ji = 1, jpi 274 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj )275 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj )274 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 275 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 276 276 END DO 277 277 END DO … … 297 297 DO jj = 1 , jpj 298 298 DO ji = 1, jpi 299 wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj )299 wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj,1) 300 300 END DO 301 301 END DO … … 317 317 ! 318 318 zsst = pst(ji,jj) + rt0 ! converte Celcius to Kelvin the SST 319 ztatm = sf(jp_tair)%fnow(ji,jj )! and set minimum value far above 0 K (=rt0 over land)320 zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj )! fraction of clear sky ( 1 - cloud cover)319 ztatm = sf(jp_tair)%fnow(ji,jj,1) ! and set minimum value far above 0 K (=rt0 over land) 320 zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ! fraction of clear sky ( 1 - cloud cover) 321 321 zrhoa = zpatm / ( 287.04 * ztatm ) ! air density (equation of state for dry air) 322 322 ztamr = ztatm - rtt ! Saturation water vapour … … 325 325 zmt3 = SIGN( 28.200, -ztamr ) ! \/ 326 326 zes = 611.0 * EXP( ABS( ztamr ) * MIN ( zmt1, zmt2 ) / ( ztatm - 35.86 + MAX( 0.e0, zmt3 ) ) ) 327 zev = sf(jp_humi)%fnow(ji,jj ) * zes! vapour pressure327 zev = sf(jp_humi)%fnow(ji,jj,1) * zes ! vapour pressure 328 328 zevsqr = SQRT( zev * 0.01 ) ! square-root of vapour pressure 329 329 zqatm = 0.622 * zev / ( zpatm - 0.378 * zev ) ! specific humidity … … 333 333 !--------------------------------------! 334 334 ztatm3 = ztatm * ztatm * ztatm 335 zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj ) * sf(jp_ccov)%fnow(ji,jj)335 zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1) 336 336 ztaevbk = ztatm * ztatm3 * zcldeff * ( 0.39 - 0.05 * zevsqr ) 337 337 ! … … 351 351 zdeltaq = zqatm - zqsato 352 352 ztvmoy = ztatm * ( 1. + 2.2e-3 * ztatm * zqatm ) 353 zdenum = MAX( sf(jp_wndm)%fnow(ji,jj ) * sf(jp_wndm)%fnow(ji,jj) * ztvmoy, zeps )353 zdenum = MAX( sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, zeps ) 354 354 zdtetar = zdteta / zdenum 355 355 ztvmoyr = ztvmoy * ztvmoy * zdeltaq / zdenum … … 373 373 zpsil = zpsih 374 374 375 zvatmg = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj ) * sf(jp_wndm)%fnow(ji,jj) / grav, zeps )375 zvatmg = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, zeps ) 376 376 zcmn = vkarmn / LOG ( 10. / zvatmg ) 377 377 zchn = 0.0327 * zcmn … … 387 387 zcleo = zcln * zclcm 388 388 389 zrhova = zrhoa * sf(jp_wndm)%fnow(ji,jj )389 zrhova = zrhoa * sf(jp_wndm)%fnow(ji,jj,1) 390 390 391 391 ! sensible heat flux … … 408 408 DO ji = 1, jpi 409 409 qns (ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj) ! Downward Non Solar flux 410 emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj ) / rday * tmask(ji,jj,1)410 emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj,1) / rday * tmask(ji,jj,1) 411 411 END DO 412 412 END DO … … 530 530 !CDIR NOVERRCHK 531 531 DO ji = 1, jpi 532 ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj )! air temperature in Kelvins532 ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1) ! air temperature in Kelvins 533 533 534 534 zrhoa(ji,jj) = zpatm / ( 287.04 * ztatm(ji,jj) ) ! air density (equation of state for dry air) … … 541 541 & / ( ztatm(ji,jj) - 35.86 + MAX( 0.e0, zmt3 ) ) ) 542 542 543 zev = sf(jp_humi)%fnow(ji,jj ) * zes ! vapour pressure543 zev = sf(jp_humi)%fnow(ji,jj,1) * zes ! vapour pressure 544 544 zevsqr(ji,jj) = SQRT( zev * 0.01 ) ! square-root of vapour pressure 545 545 zqatm(ji,jj) = 0.622 * zev / ( zpatm - 0.378 * zev ) ! specific humidity … … 551 551 zmt2 = ( 272.0 - ztatm(ji,jj) ) / 38.0 ; zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 552 552 zmt3 = ( 281.0 - ztatm(ji,jj) ) / 18.0 ; zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 553 p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj ) / rday &! rday = converte mm/day to kg/m2/s553 p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s 554 554 & * ( zind1 & ! solid (snow) precipitation [kg/m2/s] 555 555 & + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) & … … 561 561 ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 562 562 ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 563 p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj ) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj)564 p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj ) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj)563 p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 564 p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 565 565 END DO 566 566 END DO … … 584 584 !-------------------------------------------! 585 585 ztatm3 = ztatm(ji,jj) * ztatm(ji,jj) * ztatm(ji,jj) 586 zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj ) * sf(jp_ccov)%fnow(ji,jj)586 zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1) 587 587 ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 588 588 ! … … 609 609 610 610 ! sensible and latent fluxes over ice 611 zrhova = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj ) ! computation of intermediate values611 zrhova = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj,1) ! computation of intermediate values 612 612 zrhovaclei = zrhova * zcshi * 2.834e+06 613 613 zrhovacshi = zrhova * zclei * 1004.0 … … 639 639 p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:) ! Downward Non Solar flux 640 640 !CDIR COLLAPSE 641 p_tpr(:,:) = sf(jp_prec)%fnow(:,: ) / rday ! total precipitation [kg/m2/s]641 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 642 642 ! 643 643 !!gm : not necessary as all input data are lbc_lnk... … … 735 735 !CDIR NOVERRCHK 736 736 DO ji = 1, jpi 737 ztamr = sf(jp_tair)%fnow(ji,jj ) - rtt737 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt 738 738 zmt1 = SIGN( 17.269, ztamr ) 739 739 zmt2 = SIGN( 21.875, ztamr ) 740 740 zmt3 = SIGN( 28.200, -ztamr ) 741 741 zes = 611.0 * EXP( ABS( ztamr ) * MIN ( zmt1, zmt2 ) & ! Saturation water vapour 742 & / ( sf(jp_tair)%fnow(ji,jj ) - 35.86 + MAX( 0.e0, zmt3 ) ) )743 zev(ji,jj) = sf(jp_humi)%fnow(ji,jj ) * zes * 1.0e-05 ! vapour pressure742 & / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86 + MAX( 0.e0, zmt3 ) ) ) 743 zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05 ! vapour pressure 744 744 END DO 745 745 END DO … … 798 798 799 799 ! ocean albedo depending on the cloud cover (Payne, 1972) 800 za_oce = ( 1.0 - sf(jp_ccov)%fnow(ji,jj ) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 ) & ! clear sky801 & + sf(jp_ccov)%fnow(ji,jj ) * 0.06 ! overcast800 za_oce = ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 ) & ! clear sky 801 & + sf(jp_ccov)%fnow(ji,jj,1) * 0.06 ! overcast 802 802 803 803 ! solar heat flux absorbed by the ocean (Zillman, 1972) … … 814 814 DO ji = 1, jpi 815 815 zlmunoon = ASIN( zps(ji,jj) + zpc(ji,jj) ) / rad ! local noon solar altitude 816 zcldcor = MIN( 1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj ) & ! cloud correction (Reed 1977)816 zcldcor = MIN( 1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj,1) & ! cloud correction (Reed 1977) 817 817 & + 0.0019 * zlmunoon ) ) 818 818 pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1) ! and zcoef1: ellipsity … … 865 865 !CDIR NOVERRCHK 866 866 DO ji = 1, jpi 867 ztamr = sf(jp_tair)%fnow(ji,jj ) - rtt867 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt 868 868 zmt1 = SIGN( 17.269, ztamr ) 869 869 zmt2 = SIGN( 21.875, ztamr ) 870 870 zmt3 = SIGN( 28.200, -ztamr ) 871 871 zes = 611.0 * EXP( ABS( ztamr ) * MIN ( zmt1, zmt2 ) & ! Saturation water vapour 872 & / ( sf(jp_tair)%fnow(ji,jj ) - 35.86 + MAX( 0.e0, zmt3 ) ) )873 zev(ji,jj) = sf(jp_humi)%fnow(ji,jj ) * zes * 1.0e-05 ! vapour pressure872 & / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86 + MAX( 0.e0, zmt3 ) ) ) 873 zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05 ! vapour pressure 874 874 END DO 875 875 END DO … … 938 938 & / ( 1.0 + 0.139 * stauc(ji,jj) * ( 1.0 - 0.9435 * pa_ice_os(ji,jj,jl) ) ) 939 939 940 pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + ( ( 1.0 - sf(jp_ccov)%fnow(ji,jj ) ) * zqsr_ice_cs &941 & + sf(jp_ccov)%fnow(ji,jj ) * zqsr_ice_os )940 pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + ( ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * zqsr_ice_cs & 941 & + sf(jp_ccov)%fnow(ji,jj,1) * zqsr_ice_os ) 942 942 END DO 943 943 END DO -
branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r2075 r2077 164 164 ENDIF 165 165 DO ifpr= 1, jfld 166 ALLOCATE( sf(ifpr)%fnow(jpi,jpj ) )167 ALLOCATE( sf(ifpr)%fdta(jpi,jpj, 2) )166 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 167 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 168 168 END DO 169 169 ! … … 176 176 177 177 #if defined key_lim3 178 tatm_ice(:,:) = sf(jp_tair)%fnow(:,: )178 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 179 179 #endif 180 180 … … 244 244 DO jj = 2, jpjm1 245 245 DO ji = fs_2, fs_jpim1 ! vect. opt. 246 zwnd_i(ji,jj) = ( sf(jp_wndi)%fnow(ji,jj ) - 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) )247 zwnd_j(ji,jj) = ( sf(jp_wndj)%fnow(ji,jj ) - 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) )246 zwnd_i(ji,jj) = ( sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) ) 247 zwnd_j(ji,jj) = ( sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) ) 248 248 END DO 249 249 END DO … … 262 262 ! ocean albedo assumed to be 0.066 263 263 !CDIR COLLAPSE 264 qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,: ) * tmask(:,:,1) ! Short Wave265 !CDIR COLLAPSE 266 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,: ) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave264 qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) ! Short Wave 265 !CDIR COLLAPSE 266 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 267 267 268 268 ! ----------------------------------------------------------------------------- ! … … 307 307 IF( lhftau ) THEN 308 308 !CDIR COLLAPSE 309 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,: )309 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 310 310 ENDIF 311 311 CALL iom_put( "taum_oce", taum ) ! output wind stress module … … 330 330 ELSE 331 331 !CDIR COLLAPSE 332 zevap(:,:) = MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,: ) ) * wndm(:,:) ) ! Evaporation333 !CDIR COLLAPSE 334 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - sf(jp_tair)%fnow(:,: ) ) * wndm(:,:) ! Sensible Heat332 zevap(:,:) = MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) ) ! Evaporation 333 !CDIR COLLAPSE 334 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:) ! Sensible Heat 335 335 ENDIF 336 336 !CDIR COLLAPSE … … 355 355 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! Downward Non Solar flux 356 356 !CDIR COLLAPSE 357 emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,: ) * rn_pfac * tmask(:,:,1)357 emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) 358 358 !CDIR COLLAPSE 359 359 emps(:,:) = emp(:,:) … … 453 453 DO ji = 2, jpim1 ! B grid : no vector opt 454 454 ! ... scalar wind at I-point (fld being at T-point) 455 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ) + sf(jp_wndi)%fnow(ji ,jj) &456 & + sf(jp_wndi)%fnow(ji-1,jj-1 ) + sf(jp_wndi)%fnow(ji ,jj-1) ) - pui(ji,jj)457 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ) + sf(jp_wndj)%fnow(ji ,jj) &458 & + sf(jp_wndj)%fnow(ji-1,jj-1 ) + sf(jp_wndj)%fnow(ji ,jj-1) ) - pvi(ji,jj)455 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ,1) + sf(jp_wndi)%fnow(ji ,jj ,1) & 456 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - pui(ji,jj) 457 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) & 458 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - pvi(ji,jj) 459 459 zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 460 460 ! ... ice stress at I-point … … 462 462 p_tauj(ji,jj) = zwnorm_f * zwndj_f 463 463 ! ... scalar wind at T-point (fld being at T-point) 464 zwndi_t = sf(jp_wndi)%fnow(ji,jj ) - 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) &464 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) & 465 465 & + pui(ji,jj ) + pui(ji+1,jj ) ) 466 zwndj_t = sf(jp_wndj)%fnow(ji,jj ) - 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) &466 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) & 467 467 & + pvi(ji,jj ) + pvi(ji+1,jj ) ) 468 468 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) … … 479 479 DO jj = 2, jpj 480 480 DO ji = fs_2, jpi ! vect. opt. 481 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj ) - 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) )482 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj ) - 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) )481 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) ) 482 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) ) 483 483 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 484 484 END DO … … 490 490 DO ji = fs_2, fs_jpim1 ! vect. opt. 491 491 p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj) + z_wnds_t(ji,jj) ) & 492 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj ) + sf(jp_wndi)%fnow(ji,jj) ) - pui(ji,jj) )492 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) ) 493 493 p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1) + z_wnds_t(ji,jj) ) & 494 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1 ) + sf(jp_wndj)%fnow(ji,jj) ) - pvi(ji,jj) )494 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) ) 495 495 END DO 496 496 END DO … … 515 515 zst3 = pst(ji,jj,jl) * zst2 516 516 ! Short Wave (sw) 517 p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj ) * tmask(ji,jj,1)517 p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1) 518 518 ! Long Wave (lw) 519 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj ) &519 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) & 520 520 & - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 521 521 ! lw sensitivity … … 528 528 ! ... turbulent heat fluxes 529 529 ! Sensible Heat 530 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj ) )530 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 531 531 ! Latent Heat 532 532 p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls * Cice * z_wnds_t(ji,jj) & 533 & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj ) ) )533 & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) ) 534 534 ! Latent heat sensitivity for ice (Dqla/Dt) 535 535 p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) … … 561 561 562 562 !CDIR COLLAPSE 563 p_tpr(:,:) = sf(jp_prec)%fnow(:,: ) * rn_pfac ! total precipitation [kg/m2/s]564 !CDIR COLLAPSE 565 p_spr(:,:) = sf(jp_snow)%fnow(:,: ) * rn_pfac ! solid precipitation [kg/m2/s]563 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 564 !CDIR COLLAPSE 565 p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 566 566 CALL iom_put( 'snowpre', p_spr ) ! Snow precipitation 567 567 ! -
branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcflx.F90
r2075 r2077 126 126 ENDIF 127 127 DO ji= 1, jpfld 128 ALLOCATE( sf(ji)%fnow(jpi,jpj ) )129 ALLOCATE( sf(ji)%fdta(jpi,jpj, 2) )128 ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 129 ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 130 130 END DO 131 131 … … 145 145 DO jj = 1, jpj 146 146 DO ji = 1, jpi 147 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj )148 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj )149 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj ) - sf(jp_qsr)%fnow(ji,jj)150 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj )151 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj )147 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 148 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 149 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 150 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 151 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 152 152 END DO 153 153 END DO -
branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcice_if.F90
r2075 r2077 81 81 CALL ctl_stop( 'sbc_ice_if: unable to allocate sf_ice structure' ) ; RETURN 82 82 ENDIF 83 ALLOCATE( sf_ice(1)%fnow(jpi,jpj ) )84 ALLOCATE( sf_ice(1)%fdta(jpi,jpj, 2) )83 ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) ) 84 ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) ) 85 85 86 86 … … 107 107 ! 108 108 zt_fzp = fr_i(ji,jj) ! freezing point temperature 109 zfr_obs = sf_ice(1)%fnow(ji,jj ) ! observed ice cover109 zfr_obs = sf_ice(1)%fnow(ji,jj,1) ! observed ice cover 110 110 ! ! ocean ice fraction (0/1) from the freezing point temperature 111 111 IF( sst_m(ji,jj) <= zt_fzp ) THEN ; fr_i(ji,jj) = 1.e0 -
branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r2076 r2077 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 case11 10 !!---------------------------------------------------------------------- 12 11 #if defined key_lim2 … … 54 53 PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90 55 54 55 CHARACTER(len=1) :: cl_grid = 'B' ! type of grid used in ice dynamics 56 56 57 !! * Substitutions 57 58 # include "domzgr_substitute.h90" … … 171 172 ! Ice model step ! 172 173 ! ---------------- ! 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) 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 ) -
branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcrnf.F90
r2075 r2077 75 75 CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' ) ; RETURN 76 76 ENDIF 77 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj ) )78 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj, 2) )77 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) ) 78 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 79 79 ENDIF 80 80 CALL sbc_rnf_init(sf_rnf) … … 93 93 DO jj = 1, jpj 94 94 DO ji = 1, jpi 95 IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 ) sf_rnf(1)%fnow(ji,jj ) = 0.85 * sf_rnf(1)%fnow(ji,jj)95 IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 ) sf_rnf(1)%fnow(ji,jj,1) = 0.85 * sf_rnf(1)%fnow(ji,jj,1) 96 96 END DO 97 97 END DO … … 101 101 102 102 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 103 emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,: ) )104 emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,: ) )103 emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 104 emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 105 105 CALL iom_put( "runoffs", sf_rnf(1)%fnow ) ! runoffs 106 106 ENDIF -
branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcssr.F90
r2075 r2077 115 115 CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' ) ; RETURN 116 116 ENDIF 117 ALLOCATE( sf_sst(1)%fnow(jpi,jpj ) )118 ALLOCATE( sf_sst(1)%fdta(jpi,jpj, 2) )117 ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) ) 118 ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) ) 119 119 ! 120 120 ! fill sf_sst with sn_sst and control print … … 128 128 CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' ) ; RETURN 129 129 ENDIF 130 ALLOCATE( sf_sss(1)%fnow(jpi,jpj ) )131 ALLOCATE( sf_sss(1)%fdta(jpi,jpj, 2) )130 ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1) ) 131 ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) ) 132 132 ! 133 133 ! fill sf_sss with sn_sss and control print … … 153 153 DO jj = 1, jpj 154 154 DO ji = 1, jpi 155 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj ) )155 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 156 156 qns(ji,jj) = qns(ji,jj) + zqrp 157 157 qrp(ji,jj) = zqrp … … 167 167 DO ji = 1, jpi 168 168 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 169 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj ) ) &169 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 170 170 & / ( sss_m(ji,jj) + 1.e-20 ) 171 171 emps(ji,jj) = emps(ji,jj) + zerp … … 182 182 DO ji = 1, jpi 183 183 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 184 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj ) ) &184 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 185 185 & / ( sss_m(ji,jj) + 1.e-20 ) 186 186 IF( ln_sssr_bnd ) zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) -
branches/devmercator2010/NEMO/OPA_SRC/TRA/traqsr.F90
r2075 r2077 142 142 !CDIR NOVERRCHK 143 143 DO ji = 1, jpi 144 zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj ) ) )144 zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 145 145 irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 146 146 zekb(ji,jj) = rkrgb(1,irgb) … … 334 334 CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' ) ; RETURN 335 335 ENDIF 336 ALLOCATE( sf_chl(1)%fnow(jpi,jpj ) )337 ALLOCATE( sf_chl(1)%fdta(jpi,jpj, 2) )336 ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1) ) 337 ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) ) 338 338 ! ! fill sf_chl with sn_chl and control print 339 339 CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init', & -
branches/devmercator2010/NVTK/INSTALL/JOBS/job_ORCA2_LIM.ksh
r2075 r2077 196 196 if [ "${USE_IOSERVER}" = "true" ] 197 197 then 198 cp ${ WORK}/../bin/ioserver ioserver198 cp ${MAINDIR}/modipsl/bin/ioserver ioserver 199 199 chmod 777 ioserver 200 200 fi -
branches/devmercator2010/NVTK/INSTALL/JOBS/job_ORCA2_LIM3.ksh
r2075 r2077 192 192 if [ "${USE_IOSERVER}" = "true" ] 193 193 then 194 cp ${ WORK}/../bin/ioserver ioserver194 cp ${MAINDIR}/modipsl/bin/ioserver ioserver 195 195 chmod 777 ioserver 196 196 fi
Note: See TracChangeset
for help on using the changeset viewer.