Changeset 3764 for branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2
- Timestamp:
- 2013-01-23T15:33:04+01:00 (11 years ago)
- Location:
- branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2
- Files:
-
- 4 edited
-
dom_ice_2.F90 (modified) (1 diff)
-
limtrp_2.F90 (modified) (1 diff)
-
limwri_2.F90 (modified) (5 diffs)
-
limwri_dimg_2.h90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90
r2715 r3764 32 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tms , tmu !: temperature and velocity points masks 33 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wght !: weight of the 4 neighbours to compute averages 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmv !: y-velocity mask used for evp rheology 34 35 35 36 # if defined key_lim2_vp37 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: akappa , bkappa !: first and third group of metric coefficients 38 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:,:) :: alambd !: second group of metric coefficients 39 # else 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmv , tmf !: y-velocity and F-points masks 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmf !: F-points masks 41 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmi !: ice mask: =1 if ice thick > 0 42 # endif43 40 !!---------------------------------------------------------------------- 44 41 CONTAINS -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90
r3680 r3764 31 31 USE agrif_lim2_interp ! nesting 32 32 # endif 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 34 34 35 IMPLICIT NONE -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r3625 r3764 105 105 !! 106 106 INTEGER :: ji, jj, jf ! dummy loop indices 107 CHARACTER(len = 40) :: clhstnam, clop107 CHARACTER(len = 80) :: clhstnam, clop 108 108 REAL(wp) :: zsto, zjulian, zout, & ! temporary scalars 109 109 & zindh, zinda, zindb, ztmu … … 161 161 zcmo(ji,jj,5) = sist (ji,jj) 162 162 zcmo(ji,jj,6) = fbif (ji,jj) 163 IF (lk_lim2_vp) THEN 163 164 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 164 165 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & … … 168 169 + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 169 170 / ztmu 171 ELSE 172 173 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) & 174 & + u_ice(ji-1,jj) * tmu(ji-1,jj) ) & 175 & / 2.0 176 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) & 177 & + v_ice(ji,jj-1) * tmv(ji,jj-1) ) & 178 & / 2.0 179 180 ENDIF 170 181 zcmo(ji,jj,9) = sst_m(ji,jj) 171 182 zcmo(ji,jj,10) = sss_m(ji,jj) … … 187 198 niter = niter + 1 188 199 DO jf = 1 , noumef 189 DO jj = 1 , jpj 190 DO ji = 1 , jpi 191 zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf) 192 END DO 193 END DO 194 195 IF( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN 200 zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) * tmask(:,:,1) 201 SELECT CASE ( jf ) 202 CASE ( 7, 8, 15, 16, 20, 21 ) ! velocity or stress fields (vectors) 196 203 CALL lbc_lnk( zfield, 'T', -1. ) 197 ELSE204 CASE DEFAULT ! scalar fields 198 205 CALL lbc_lnk( zfield, 'T', 1. ) 199 END IF200 206 END SELECT 207 201 208 IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 202 209 203 210 END DO 204 211 205 212 IF( ( nn_fsbc * niter ) >= nitend ) CALL histclo( nice ) 206 213 … … 209 216 END SUBROUTINE lim_wri_2 210 217 211 # endif218 #endif 212 219 213 220 SUBROUTINE lim_wri_init_2 -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
r3625 r3764 20 20 INTEGER , SAVE :: nmoyice !: counter for averaging 21 21 INTEGER , SAVE :: nwf !: number of fields to write on disk 22 INTEGER , SAVE, DIMENSION(:), ALLOCATABLE :: nsubindex !: subindex to be saved22 INTEGER, SAVE,DIMENSION (:), ALLOCATABLE :: nsubindex !: subindex to be saved 23 23 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 24 24 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy … … 30 30 REAL(wp), DIMENSION(1) :: zdept 31 31 REAL(wp) :: zsto, zsec, zjulian,zout 32 REAL(wp) :: zindh,zinda,zindb, ztmu 33 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo !ARPDBGWORK 34 REAL(wp), DIMENSION(jpi,jpj) :: zfield 32 REAL(wp) :: zindh, zinda, zindb, ztmu 33 REAL(wp), POINTER, DIMENSION(:,:) :: zfield 35 34 36 35 #if ! defined key_diainstant … … 45 44 IF( lk_mpp ) CALL mpp_sum ( ialloc ) 46 45 IF( ialloc /= 0 ) CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays') 47 rcmoy(:,:,:) = 0._wp48 46 ENDIF 49 47 50 IF( kt == nit000 ) THEN 48 CALL wrk_alloc( jpi, jpj, zfield ) 49 50 IF ( kt == nit000 ) THEN 51 51 ! 52 52 CALL lim_wri_init_2 … … 55 55 ii = 0 56 56 57 IF (lwp ) THEN57 IF (lwp ) THEN 58 58 WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg' 59 59 WRITE(numout,*) '~~~~~~~~' … … 79 79 END DO 80 80 81 rcmoy(:,:,:) = 0.0_wp 81 82 zsto = rdt_ice 82 83 zout = nwrite * rdt_ice / nn_fsbc … … 89 90 90 91 #if ! defined key_diainstant 91 !-- calculs des valeurs instantanees92 !-- Compute mean values 92 93 93 94 zcmo(:,:, 1:jpnoumax ) = 0.e0 94 95 DO jj = 2 , jpjm1 95 DO ji = 2 , jpim1 ! NO vector opt.96 DO ji = 2 , jpim1 96 97 zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 97 98 zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 98 99 zindb = zindh * zinda 99 ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )100 100 zcmo(ji,jj,1) = hsnif (ji,jj) 101 101 zcmo(ji,jj,2) = hicif (ji,jj) … … 104 104 zcmo(ji,jj,5) = sist (ji,jj) 105 105 zcmo(ji,jj,6) = fbif (ji,jj) 106 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 106 IF (lk_lim2_vp) THEN 107 ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 108 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 107 109 & + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 108 110 / ztmu 109 111 110 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) &112 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) & 111 113 & + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 112 114 / ztmu 115 ELSE 116 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0 117 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0 118 ENDIF 119 113 120 zcmo(ji,jj,9) = sst_m(ji,jj) 114 121 zcmo(ji,jj,10) = sss_m(ji,jj) … … 136 143 ! case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 137 144 DO jj = 2 , jpjm1 138 DO ji = 2 , jpim1 ! NO vector opt.145 DO ji = 2 , jpim1 139 146 zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 140 147 zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 141 148 zindb = zindh * zinda 142 ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )143 149 rcmoy(ji,jj,1) = hsnif (ji,jj) 144 150 rcmoy(ji,jj,2) = hicif (ji,jj) … … 147 153 rcmoy(ji,jj,5) = sist (ji,jj) 148 154 rcmoy(ji,jj,6) = fbif (ji,jj) 149 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 150 & + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 151 / ztmu 152 153 rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) & 154 & + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 155 / ztmu 155 IF (lk_lim2_vp) THEN 156 ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 157 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 158 & + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 159 / ztmu 160 161 rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) & 162 & + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 163 / ztmu 164 ELSE 165 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0 166 rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0 167 ENDIF 156 168 rcmoy(ji,jj,9) = sst_m(ji,jj) 157 169 rcmoy(ji,jj,10) = sss_m(ji,jj) … … 176 188 zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 177 189 178 IF ( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN 190 SELECT CASE (jf) 191 CASE ( 7, 8, 15, 16 ) ! velocity or stress fields (vectors) 179 192 CALL lbc_lnk( zfield, 'T', -1. ) 180 ELSE193 CASE DEFAULT ! scalar fields 181 194 CALL lbc_lnk( zfield, 'T', 1. ) 182 END IF195 END SELECT 183 196 rcmoy(:,:,jf) = zfield(:,:) 184 197 END DO … … 200 213 nmoyice = 0 201 214 END IF ! MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) ! 215 CALL wrk_dealloc( jpi,jpj, zfield ) 202 216 203 217 END SUBROUTINE lim_wri_2
Note: See TracChangeset
for help on using the changeset viewer.
