Changeset 508 for trunk/NEMO/LIM_SRC/limdmp.F90
- Timestamp:
- 2006-10-03T17:58:55+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC/limdmp.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC/limdmp.F90
r477 r508 4 4 !! Ice model : restoring Ice thickness and Fraction leads 5 5 !!====================================================================== 6 #if defined key_ice_lim && defined key_tradmp 6 !! History : 2.0 ! 04-04 (S. Theetten) Original code 7 7 !!---------------------------------------------------------------------- 8 !! 'key_ice_lim' : LIM sea-ice model 8 #if defined key_ice_lim && defined key_tradmp 9 !!---------------------------------------------------------------------- 10 !! 'key_ice_lim' AND LIM sea-ice model 11 !! 'key_tradmp' Damping 12 !!---------------------------------------------------------------------- 9 13 !!---------------------------------------------------------------------- 10 14 !! lim_dmp : ice model damping 11 15 !!---------------------------------------------------------------------- 12 !! * Modules used13 16 USE in_out_manager ! I/O manager 17 USE phycst ! physical constants 14 18 USE ice 15 19 USE ice_oce … … 18 22 USE oce 19 23 USE daymod ! calendar 24 USE iom 20 25 21 26 IMPLICIT NONE 22 27 PRIVATE 23 28 24 !! * Routine accessibility 25 PUBLIC lim_dmp ! called by ice_step 29 PUBLIC lim_dmp ! called by ice_step 26 30 27 !! * Shared module variables 28 CHARACTER (len=38) :: & 29 cl_icedata = 'ice_damping_ATL4.nc' 30 INTEGER :: & 31 nice1 , & ! first record used 32 nice2 ! second record used 33 34 REAL(wp), DIMENSION(jpi,jpj,2) :: & 35 hicif_data , & ! ice thickness data at two consecutive times 36 frld_data ! fraction lead data at two consecutive times 37 38 REAL(wp), DIMENSION(jpi,jpj) :: & 39 hicif_dta , & ! ice thickness at a given time 40 frld_dta ! fraction lead at a given time 31 INTEGER :: nice1, nice2, & ! first and second record used 32 & inumice_dmp ! logical unit for ice variables (damping) 33 REAL(wp), DIMENSION(jpi,jpj) :: hicif_dta , & ! ice thickness at a given time 34 & frld_dta ! fraction lead at a given time 35 REAL(wp), DIMENSION(jpi,jpj,2) :: hicif_data , & ! ice thickness data at two consecutive times 36 & frld_data ! fraction lead data at two consecutive times 41 37 42 38 !! * Substitution 43 39 # include "vectopt_loop_substitute.h90" 44 40 !!---------------------------------------------------------------------- 45 !! LIM 2.0 , UCL-LOCEAN-IPSL (200 5)41 !! LIM 2.0 , UCL-LOCEAN-IPSL (2006) 46 42 !! $Header$ 47 !! This software is governed by the CeCILL licence see !modipsl/doc/NEMO_CeCILL.txt43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 48 44 !!---------------------------------------------------------------------- 49 45 … … 58 54 !! 59 55 !! ** method : the key_tradmp must be used to compute resto(:,:) coef. 60 !!61 !! ** action :62 !!63 !! History :64 !!65 !! 2.0 ! 04-04 (S. Theetten) Original66 56 !!--------------------------------------------------------------------- 67 !! * Arguments 68 INTEGER, INTENT( in ) :: kt ! ocean time-step 69 70 !! * Local Variables 71 INTEGER :: ji, jj ! dummy loop indices 57 INTEGER, INTENT(in) :: kt ! ocean time-step 58 ! 59 INTEGER :: ji, jj ! dummy loop indices 72 60 !!--------------------------------------------------------------------- 73 74 CALL dta_lim( kt)61 ! 62 CALL dta_lim( kt ) 75 63 76 64 DO jj = 2, jpjm1 77 65 DO ji = fs_2, fs_jpim1 ! vector opt. 78 79 hicif(ji,jj) = hicif(ji,jj) - rdt_ice * resto(ji,jj,1) * ( hicif(ji,jj) - hicif_dta(ji,jj)) 80 frld(ji,jj) = frld(ji,jj) - rdt_ice * resto(ji,jj,1) * ( frld(ji,jj) - frld_dta(ji,jj)) 81 82 ENDDO 83 ENDDO 84 66 hicif(ji,jj) = hicif(ji,jj) - rdt_ice * resto(ji,jj,1) * ( hicif(ji,jj) - hicif_dta(ji,jj) ) 67 frld(ji,jj) = frld (ji,jj) - rdt_ice * resto(ji,jj,1) * ( frld(ji,jj) - frld_dta (ji,jj) ) 68 END DO 69 END DO 70 ! 85 71 END SUBROUTINE lim_dmp 86 87 72 88 73 … … 101 86 !! two monthly values. 102 87 !! 103 !!104 88 !! ** Action : define hicif_dta and frld_dta arrays at time-step kt 105 !!106 !! History :107 !! 2.0 ! 04-04 (S. Theetten) Original108 89 !!---------------------------------------------------------------------- 109 !! * Modules used 110 USE ioipsl 111 112 !! * Arguments 113 INTEGER, INTENT( in ) :: kt ! ocean time-step 114 115 !! * Local declarations 116 INTEGER, PARAMETER :: jpmois = 12 ! number of month 117 118 INTEGER :: & 119 imois, iman, itime , & ! temporary integers 120 i15, ipi, ipj, ipk ! " " 121 122 INTEGER, DIMENSION(jpmois) :: istep 123 REAL(wp) :: zxy, zdate0, zdt 124 REAL(wp), DIMENSION(jpi,jpj) :: zlon,zlat 125 REAL(wp), DIMENSION(jpk) :: zlev 90 INTEGER, INTENT(in) :: kt ! ocean time-step 91 ! 92 INTEGER :: imois, iman, i15 ! temporary integers 93 REAL(wp) :: zxy 126 94 !!---------------------------------------------------------------------- 127 95 128 96 ! 0. Initialization 129 97 ! ----------------- 130 iman = jpmois 98 iman = INT( raamo ) 99 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 131 100 i15 = nday / 16 132 101 imois = nmonth + i15 - 1 133 IF( imois == 0 ) imois = iman 134 135 itime = jpmois 136 ipi=jpiglo 137 ipj=jpjglo 138 ipk=1 139 zdt=rdt 140 141 ! 1. First call kt=nit000 102 IF( imois == 0 ) imois = iman 103 104 ! 1. First call kt=nit000: Initialization and Open 142 105 ! ----------------------- 143 144 106 IF( kt == nit000 ) THEN 145 107 nice1 = 0 … … 149 111 IF(lwp) WRITE(numout,*) ' NetCDF FORMAT' 150 112 IF(lwp) WRITE(numout,*) 151 152 113 ! open file 153 154 CALL flinopen( TRIM(cl_icedata), mig(1), nlci , mjg(1), nlcj, .FALSE., & 155 & ipi, ipj, ipk, zlon, zlat, zlev, itime, istep, zdate0, zdt, numice_dmp ) 156 157 ! title, dimensions and tests 158 IF( itime /= jpmois ) THEN 159 IF(lwp) THEN 160 WRITE(numout,*) 161 WRITE(numout,*) 'problem with time coordinates' 162 WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 163 ENDIF 164 STOP 'dta_lim' 165 ENDIF 166 IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN 167 IF(lwp) THEN 168 WRITE(numout,*) 169 WRITE(numout,*) 'problem with dimensions' 170 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 171 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 172 ENDIF 173 STOP 'dta_lim' 174 ENDIF 175 IF(lwp) WRITE(numout,*) itime,istep,zdate0,zdt,numice_dmp 176 114 CALL iom_open( 'ice_damping_ATL4.nc', inumice_dmp ) 177 115 ENDIF 178 116 179 117 180 118 ! 2. Read monthly file 181 ! ------------------- 182 119 ! -------------------- 183 120 IF( ( kt == nit000 ) .OR. imois /= nice1 ) THEN 184 121 ! 185 122 ! Calendar computation 186 187 123 nice1 = imois ! first file record used 188 124 nice2 = nice1 + 1 ! last file record used 189 125 nice1 = MOD( nice1, iman ) 126 nice2 = MOD( nice2, iman ) 190 127 IF( nice1 == 0 ) nice1 = iman 191 nice2 = MOD( nice2, iman )192 128 IF( nice2 == 0 ) nice2 = iman 193 129 IF(lwp) WRITE(numout,*) 'first record file used nice1 ', nice1 … … 195 131 196 132 ! Read monthly ice thickness Levitus 133 CALL iom_get( inumice_dmp, jpdom_data, 'iicethic', hicif_data(:,:,1), nice1 ) 134 CALL iom_get( inumice_dmp, jpdom_data, 'iicethic', hicif_data(:,:,2), nice2 ) 197 135 198 CALL flinget( numice_dmp, 'iicethic', jpidta, jpjdta, jpk, &199 & jpmois, nice1, nice1, mig(1), nlci, mjg(1), nlcj, hicif_data(1:nlci,1:nlcj,1) )200 CALL flinget( numice_dmp, 'iicethic', jpidta, jpjdta, jpk, &201 & jpmois, nice2, nice2, mig(1), nlci, mjg(1), nlcj, hicif_data(1:nlci,1:nlcj,2) )202 203 IF(lwp) WRITE(numout,*)204 IF(lwp) WRITE(numout,*) ' read ice thickness ok'205 IF(lwp) WRITE(numout,*)206 207 136 ! Read monthly ice thickness Levitus 208 209 CALL flinget( numice_dmp, 'ileadfra', jpidta, jpjdta, jpk, & 210 & jpmois, nice1, nice1, mig(1), nlci, mjg(1), nlcj, frld_data(1:nlci,1:nlcj,1) ) 211 CALL flinget( numice_dmp, 'ileadfra', jpidta, jpjdta, jpk, & 212 & jpmois, nice2, nice2, mig(1), nlci, mjg(1), nlcj, frld_data(1:nlci,1:nlcj,2) ) 137 CALL iom_get( inumice_dmp, jpdom_data, 'ileadfra', frld_data(:,:,1), nice1 ) 138 CALL iom_get( inumice_dmp, jpdom_data, 'ileadfra', frld_data(:,:,2), nice2 ) 213 139 214 140 ! The fraction lead read in the file is in fact the … … 216 142 frld_data = 1 - frld_data 217 143 218 IF(lwp) WRITE(numout,*)219 IF(lwp) WRITE(numout,*) ' read fraction lead ok'220 IF(lwp) WRITE(numout,*)221 222 223 144 IF(lwp) THEN 145 WRITE(numout,*) 224 146 WRITE(numout,*) ' Ice thickness month ', nice1,' and ', nice2 225 147 WRITE(numout,*) … … 235 157 ! 2. At every time step compute ice thickness and fraction lead data 236 158 ! ------------------------------------------------------------------ 237 238 159 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 239 160 hicif_dta(:,:) = (1.-zxy) * hicif_data(:,:,1) + zxy * hicif_data(:,:,2) … … 241 162 242 163 ENDIF 243 244 164 165 IF( kt == nitend ) CALL iom_close( inumice_dmp ) 166 ! 245 167 END SUBROUTINE dta_lim 246 168 … … 250 172 !!---------------------------------------------------------------------- 251 173 CONTAINS 252 SUBROUTINE lim_dmp( kt) ! Dummy routine174 SUBROUTINE lim_dmp( kt ) ! Dummy routine 253 175 WRITE(*,*) 'lim_dmp: You should not see this print! error? ', kt 254 176 END SUBROUTINE lim_dmp … … 256 178 257 179 !!====================================================================== 258 259 180 END MODULE limdmp
Note: See TracChangeset
for help on using the changeset viewer.
