Changeset 2715 for trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r2528 r2715 5 5 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 6 6 !!---------------------------------------------------------------------- 7 SUBROUTINE agrif_before_regridding 8 END SUBROUTINE 7 9 8 10 SUBROUTINE Agrif_InitWorkspace … … 13 15 USE dom_oce 14 16 USE Agrif_Util 15 !! 16 IMPLICIT NONE 17 !! 18 #if defined key_mpp_dyndist 19 CHARACTER(len=20) :: namelistname 20 INTEGER nummpp 21 NAMELIST/nammpp_dyndist/ jpni, jpnj, jpnij 22 #endif 23 !!---------------------------------------------------------------------- 24 25 #if defined key_mpp_dyndist 26 ! MPP dynamical distribution : read the processor cutting in the namelist 27 IF( Agrif_Nbstepint() == 0 ) THEN 28 nummpp = Agrif_Get_Unit() 29 namelistname='namelist' 30 IF(.NOT. Agrif_Root() ) namelistname=TRIM(Agrif_CFixed())//'_namelist' 31 ! 32 OPEN (nummpp,file=namelistname,status='OLD',form='formatted') 33 READ (nummpp,nammpp_dyndist) 34 CLOSE(nummpp) 35 ENDIF 36 #endif 37 17 USE nemogcm 18 ! 19 IMPLICIT NONE 20 !!---------------------------------------------------------------------- 21 ! 38 22 IF( .NOT. Agrif_Root() ) THEN 23 jpni = Agrif_Parent(jpni) 24 jpnj = Agrif_Parent(jpnj) 25 jpnij = Agrif_Parent(jpnij) 39 26 jpiglo = nbcellsx + 2 + 2*nbghostcells 40 27 jpjglo = nbcellsy + 2 + 2*nbghostcells 41 28 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 42 29 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 30 jpk = jpkdta 43 31 jpim1 = jpi-1 44 32 jpjm1 = jpj-1 … … 55 43 END SUBROUTINE Agrif_InitWorkspace 56 44 57 #if ! defined key_offline58 45 59 46 SUBROUTINE Agrif_InitValues … … 67 54 USE dom_oce 68 55 USE nemogcm 69 #if defined key_top70 USE trc71 #endif72 56 #if defined key_tradmp || defined key_esopa 73 57 USE tradmp … … 76 60 USE obc_par 77 61 #endif 78 USE sol_oce 79 USE in_out_manager 80 USE agrif_opa_update 81 USE agrif_opa_interp 82 USE agrif_opa_sponge 83 USE agrif_top_update 84 USE agrif_top_interp 85 USE agrif_top_sponge 86 !! 87 IMPLICIT NONE 88 !! 89 REAL(wp) :: tabtemp(jpi,jpj,jpk) 90 #if defined key_top 91 REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 92 #endif 93 LOGICAL check_namelist 62 IMPLICIT NONE 94 63 !!---------------------------------------------------------------------- 95 64 … … 111 80 #endif 112 81 113 Call nemo_init ! Initializations of each fine grid 114 Call agrif_nemo_init 115 82 CALL nemo_init ! Initializations of each fine grid 83 CALL agrif_nemo_init 84 # if ! defined key_offline 85 CALL Agrif_InitValues_cont 86 # endif 87 # if defined key_top 88 CALL Agrif_InitValues_cont_top 89 # endif 90 END SUBROUTINE Agrif_initvalues 91 92 # if ! defined key_offline 93 94 SUBROUTINE Agrif_InitValues_cont 95 !!---------------------------------------------------------------------- 96 !! *** ROUTINE Agrif_InitValues_cont *** 97 !! 98 !! ** Purpose :: Declaration of variables to be interpolated 99 !!---------------------------------------------------------------------- 100 USE Agrif_Util 101 USE oce 102 USE dom_oce 103 USE nemogcm 104 USE sol_oce 105 USE in_out_manager 106 USE agrif_opa_update 107 USE agrif_opa_interp 108 USE agrif_opa_sponge 109 ! 110 IMPLICIT NONE 111 ! 112 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tabtemp 113 LOGICAL :: check_namelist 114 !!---------------------------------------------------------------------- 115 116 ALLOCATE( tabtemp(jpi,jpj,jpk) ) 117 118 116 119 ! 1. Declaration of the type of variable which have to be interpolated 117 120 !--------------------------------------------------------------------- 118 Call Agrif_Set_type(un,(/1,2,0/),(/2,3,0/)) 119 Call Agrif_Set_type(vn,(/2,1,0/),(/3,2,0/)) 120 121 Call Agrif_Set_type(ua,(/1,2,0/),(/2,3,0/)) 122 Call Agrif_Set_type(va,(/2,1,0/),(/3,2,0/)) 123 124 Call Agrif_Set_type(e1u,(/1,2/),(/2,3/)) 125 Call Agrif_Set_type(e2v,(/2,1/),(/3,2/)) 126 127 Call Agrif_Set_type(tn,(/2,2,0/),(/3,3,0/)) 128 Call Agrif_Set_type(sn,(/2,2,0/),(/3,3,0/)) 129 130 Call Agrif_Set_type(tb,(/2,2,0/),(/3,3,0/)) 131 Call Agrif_Set_type(sb,(/2,2,0/),(/3,3,0/)) 132 133 Call Agrif_Set_type(ta,(/2,2,0/),(/3,3,0/)) 134 Call Agrif_Set_type(sa,(/2,2,0/),(/3,3,0/)) 135 136 Call Agrif_Set_type(sshn,(/2,2/),(/3,3/)) 137 Call Agrif_Set_type(gcb,(/2,2/),(/3,3/)) 138 139 #if defined key_top 140 Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/)) 141 Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/)) 142 Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/)) 143 #endif 144 145 ! 2. Space directions for each variables 146 !--------------------------------------- 147 Call Agrif_Set_raf(un,(/'x','y','N'/)) 148 Call Agrif_Set_raf(vn,(/'x','y','N'/)) 149 150 Call Agrif_Set_raf(ua,(/'x','y','N'/)) 151 Call Agrif_Set_raf(va,(/'x','y','N'/)) 152 153 Call Agrif_Set_raf(e1u,(/'x','y'/)) 154 Call Agrif_Set_raf(e2v,(/'x','y'/)) 155 156 Call Agrif_Set_raf(tn,(/'x','y','N'/)) 157 Call Agrif_Set_raf(sn,(/'x','y','N'/)) 158 159 Call Agrif_Set_raf(tb,(/'x','y','N'/)) 160 Call Agrif_Set_raf(sb,(/'x','y','N'/)) 161 162 Call Agrif_Set_raf(ta,(/'x','y','N'/)) 163 Call Agrif_Set_raf(sa,(/'x','y','N'/)) 164 165 Call Agrif_Set_raf(sshn,(/'x','y'/)) 166 Call Agrif_Set_raf(gcb,(/'x','y'/)) 167 168 #if defined key_top 169 Call Agrif_Set_raf(trn,(/'x','y','N','N'/)) 170 Call Agrif_Set_raf(trb,(/'x','y','N','N'/)) 171 Call Agrif_Set_raf(tra,(/'x','y','N','N'/)) 172 #endif 173 174 ! 3. Type of interpolation 175 !------------------------- 176 Call Agrif_Set_bcinterp(tn,interp=AGRIF_linear) 177 Call Agrif_Set_bcinterp(sn,interp=AGRIF_linear) 178 179 Call Agrif_Set_bcinterp(ta,interp=AGRIF_linear) 180 Call Agrif_Set_bcinterp(sa,interp=AGRIF_linear) 181 182 Call Agrif_Set_bcinterp(un,interp1=Agrif_linear,interp2=AGRIF_ppm) 183 Call Agrif_Set_bcinterp(vn,interp1=AGRIF_ppm,interp2=Agrif_linear) 184 185 Call Agrif_Set_bcinterp(ua,interp1=Agrif_linear,interp2=AGRIF_ppm) 186 Call Agrif_Set_bcinterp(va,interp1=AGRIF_ppm,interp2=Agrif_linear) 187 188 Call Agrif_Set_bcinterp(e1u,interp1=Agrif_linear,interp2=AGRIF_ppm) 189 Call Agrif_Set_bcinterp(e2v,interp1=AGRIF_ppm,interp2=Agrif_linear) 190 191 #if defined key_top 192 Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear) 193 Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear) 194 #endif 195 196 ! 4. Location of interpolation 197 !----------------------------- 198 Call Agrif_Set_bc(un,(/0,1/)) 199 Call Agrif_Set_bc(vn,(/0,1/)) 200 201 Call Agrif_Set_bc(e1u,(/0,0/)) 202 Call Agrif_Set_bc(e2v,(/0,0/)) 203 204 Call Agrif_Set_bc(tn,(/0,1/)) 205 Call Agrif_Set_bc(sn,(/0,1/)) 206 207 Call Agrif_Set_bc(ta,(/-3*Agrif_irhox(),0/)) 208 Call Agrif_Set_bc(sa,(/-3*Agrif_irhox(),0/)) 209 210 Call Agrif_Set_bc(ua,(/-2*Agrif_irhox(),0/)) 211 Call Agrif_Set_bc(va,(/-2*Agrif_irhox(),0/)) 212 213 #if defined key_top 214 Call Agrif_Set_bc(trn,(/0,1/)) 215 Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) 216 #endif 217 218 ! 5. Update type 219 !--------------- 220 Call Agrif_Set_Updatetype(tn, update = AGRIF_Update_Average) 221 Call Agrif_Set_Updatetype(sn, update = AGRIF_Update_Average) 222 223 Call Agrif_Set_Updatetype(tb, update = AGRIF_Update_Average) 224 Call Agrif_Set_Updatetype(sb, update = AGRIF_Update_Average) 225 226 Call Agrif_Set_Updatetype(sshn, update = AGRIF_Update_Average) 227 Call Agrif_Set_Updatetype(gcb,update = AGRIF_Update_Average) 228 229 #if defined key_top 230 Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average) 231 Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average) 232 #endif 233 234 Call Agrif_Set_Updatetype(un,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 235 Call Agrif_Set_Updatetype(vn,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 236 237 Call Agrif_Set_Updatetype(e1u,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 238 Call Agrif_Set_Updatetype(e2v,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 239 240 ! 6. First interpolations of potentially non zero fields 121 CALL agrif_declare_var 122 123 ! 2. First interpolations of potentially non zero fields 241 124 !------------------------------------------------------- 242 125 Agrif_SpecialValue=0. 243 126 Agrif_UseSpecialValue = .TRUE. 244 Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.) 245 Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.) 246 Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu) 247 Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv) 248 249 Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn) 250 Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn) 251 252 Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun) 253 Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn) 254 255 #if defined key_top 256 Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 257 Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 258 #endif 127 Call Agrif_Bc_variable(tabtemp,tn_id,calledweight=1.,procname=interptn) 128 129 Call Agrif_Bc_variable(tabtemp,sn_id,calledweight=1.,procname=interpsn) 130 Call Agrif_Bc_variable(tabtemp,un_id,calledweight=1.,procname=interpu) 131 Call Agrif_Bc_variable(tabtemp,vn_id,calledweight=1.,procname=interpv) 132 133 Call Agrif_Bc_variable(tabtemp,ta_id,calledweight=1.,procname=interptn) 134 Call Agrif_Bc_variable(tabtemp,sa_id,calledweight=1.,procname=interpsn) 135 136 Call Agrif_Bc_variable(tabtemp,ua_id,calledweight=1.,procname=interpun) 137 Call Agrif_Bc_variable(tabtemp,va_id,calledweight=1.,procname=interpvn) 259 138 Agrif_UseSpecialValue = .FALSE. 260 139 261 ! 7. Some controls140 ! 3. Some controls 262 141 !----------------- 263 142 check_namelist = .true. … … 265 144 IF( check_namelist ) THEN 266 145 146 ! Check time steps 147 IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 148 WRITE(*,*) 'incompatible time step between grids' 149 WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 150 WRITE(*,*) 'child grid value : ',nint(rdt) 151 WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 152 STOP 153 ENDIF 154 155 ! Check run length 156 IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) /= (nitend-nit000+1) ) THEN 157 WRITE(*,*) 'incompatible run length between grids' 158 WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step' 159 WRITE(*,*) 'child grid value : ', (nitend-nit000+1),' time step' 160 WRITE(*,*) 'value on child grid should be: ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) 161 STOP 162 ENDIF 163 164 ! Check coordinates 165 IF( ln_zps ) THEN 166 ! check parameters for partial steps 167 IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 168 WRITE(*,*) 'incompatible e3zps_min between grids' 169 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 170 WRITE(*,*) 'child grid :',e3zps_min 171 WRITE(*,*) 'those values should be identical' 172 STOP 173 ENDIF 174 IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 175 WRITE(*,*) 'incompatible e3zps_rat between grids' 176 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 177 WRITE(*,*) 'child grid :',e3zps_rat 178 WRITE(*,*) 'those values should be identical' 179 STOP 180 ENDIF 181 ENDIF 182 ENDIF 183 184 CALL Agrif_Update_tra(0) 185 CALL Agrif_Update_dyn(0) 186 187 nbcline = 0 188 ! 189 DEALLOCATE(tabtemp) 190 ! 191 END SUBROUTINE Agrif_InitValues_cont 192 193 194 SUBROUTINE agrif_declare_var 195 !!---------------------------------------------------------------------- 196 !! *** ROUTINE agrif_declarE_var *** 197 !! 198 !! ** Purpose :: Declaration of variables to be interpolated 199 !!---------------------------------------------------------------------- 200 USE agrif_util 201 USE oce 202 IMPLICIT NONE 203 !!---------------------------------------------------------------------- 204 205 ! 1. Declaration of the type of variable which have to be interpolated 206 !--------------------------------------------------------------------- 207 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tn_id) 208 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sn_id) 209 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tb_id) 210 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sb_id) 211 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ta_id) 212 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sa_id) 213 214 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 215 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 216 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 217 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 218 219 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 220 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 221 222 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 223 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 224 225 ! 2. Type of interpolation 226 !------------------------- 227 CALL Agrif_Set_bcinterp(tn_id,interp=AGRIF_linear) 228 CALL Agrif_Set_bcinterp(sn_id,interp=AGRIF_linear) 229 CALL Agrif_Set_bcinterp(ta_id,interp=AGRIF_linear) 230 CALL Agrif_Set_bcinterp(sa_id,interp=AGRIF_linear) 231 232 Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 233 Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 234 235 Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 236 Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 237 238 Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 239 Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 240 241 ! 3. Location of interpolation 242 !----------------------------- 243 Call Agrif_Set_bc(un_id,(/0,1/)) 244 Call Agrif_Set_bc(vn_id,(/0,1/)) 245 246 Call Agrif_Set_bc(e1u_id,(/0,0/)) 247 Call Agrif_Set_bc(e2v_id,(/0,0/)) 248 249 Call Agrif_Set_bc(tn_id,(/0,1/)) 250 Call Agrif_Set_bc(sn_id,(/0,1/)) 251 252 Call Agrif_Set_bc(ta_id,(/-3*Agrif_irhox(),0/)) 253 Call Agrif_Set_bc(sa_id,(/-3*Agrif_irhox(),0/)) 254 255 Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 256 Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 257 258 ! 5. Update type 259 !--------------- 260 Call Agrif_Set_Updatetype(tn_id, update = AGRIF_Update_Average) 261 Call Agrif_Set_Updatetype(sn_id, update = AGRIF_Update_Average) 262 263 Call Agrif_Set_Updatetype(tb_id, update = AGRIF_Update_Average) 264 Call Agrif_Set_Updatetype(sb_id, update = AGRIF_Update_Average) 265 266 Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 267 Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 268 269 Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 270 Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 271 272 Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 273 Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 274 275 END SUBROUTINE agrif_declare_var 276 # endif 277 278 # if defined key_top 279 SUBROUTINE Agrif_InitValues_cont_top 280 !!---------------------------------------------------------------------- 281 !! *** ROUTINE Agrif_InitValues_cont_top *** 282 !! 283 !! ** Purpose :: Declaration of variables to be interpolated 284 !!---------------------------------------------------------------------- 285 USE Agrif_Util 286 USE oce 287 USE dom_oce 288 USE nemogcm 289 USE trc 290 USE in_out_manager 291 USE agrif_top_update 292 USE agrif_top_interp 293 USE agrif_top_sponge 294 ! 295 IMPLICIT NONE 296 ! 297 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 298 LOGICAL :: check_namelist 299 !!---------------------------------------------------------------------- 300 301 ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 302 303 304 ! 1. Declaration of the type of variable which have to be interpolated 305 !--------------------------------------------------------------------- 306 CALL agrif_declare_var_top 307 308 ! 2. First interpolations of potentially non zero fields 309 !------------------------------------------------------- 310 Agrif_SpecialValue=0. 311 Agrif_UseSpecialValue = .TRUE. 312 Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.) 313 Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 314 Agrif_UseSpecialValue = .FALSE. 315 316 ! 3. Some controls 317 !----------------- 318 check_namelist = .true. 319 320 IF( check_namelist ) THEN 321 # if defined offline 267 322 ! Check time steps 268 323 IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN … … 275 330 276 331 ! Check run length 277 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 278 Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 332 IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 279 333 WRITE(*,*) 'incompatible run length between grids' 280 WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 281 Agrif_Parent(nit000)+1),' time step' 282 WRITE(*,*) 'child grid value : ', & 283 (nitend-nit000+1),' time step' 284 WRITE(*,*) 'value on child grid should be : ', & 285 Agrif_IRhot() * (Agrif_Parent(nitend)- & 286 Agrif_Parent(nit000)+1) 334 WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step' 335 WRITE(*,*) 'child grid value : ', (nitend-nit000+1),' time step' 336 WRITE(*,*) 'value on child grid should be : ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) 287 337 STOP 288 338 ENDIF … … 306 356 ENDIF 307 357 ENDIF 308 # if defined key_top358 # endif 309 359 ! Check passive tracer cell 310 360 IF( nn_dttrc .ne. 1 ) THEN 311 361 WRITE(*,*) 'nn_dttrc should be equal to 1' 312 362 ENDIF 313 #endif314 315 363 ENDIF 316 317 #if defined key_top 364 318 365 CALL Agrif_Update_trc(0) 319 #endif320 CALL Agrif_Update_tra(0)321 CALL Agrif_Update_dyn(0)322 323 #if defined key_top324 366 nbcline_trc = 0 325 #endif 326 nbcline = 0 327 ! 328 END SUBROUTINE Agrif_InitValues 329 330 #else 331 332 SUBROUTINE Agrif_InitValues 333 !!---------------------------------------------------------------------- 334 !! *** ROUTINE Agrif_InitValues *** 367 ! 368 DEALLOCATE(tabtrtemp) 369 ! 370 END SUBROUTINE Agrif_InitValues_cont_top 371 372 373 SUBROUTINE agrif_declare_var_top 374 !!---------------------------------------------------------------------- 375 !! *** ROUTINE agrif_declare_var_top *** 335 376 !! 336 !! ** Purpose :: Declaration of variables to be interpolated 337 !!---------------------------------------------------------------------- 338 USE Agrif_Util 339 USE oce 377 !! ** Purpose :: Declaration of TOP variables to be interpolated 378 !!---------------------------------------------------------------------- 379 USE agrif_util 340 380 USE dom_oce 341 USE nemogcm342 381 USE trc 343 USE in_out_manager 344 USE agrif_top_update 345 USE agrif_top_interp 346 USE agrif_top_sponge 347 !! 348 IMPLICIT NONE 349 !! 350 REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 351 LOGICAL check_namelist 352 !!---------------------------------------------------------------------- 353 354 ! 0. Initializations 355 !------------------- 356 #if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4 357 jp_cfg = -1 ! set special value for jp_cfg on fine grids 358 cp_cfg = "default" 359 #endif 360 361 Call nemo_init ! Initializations of each fine grid 362 Call agrif_nemo_init 363 382 383 IMPLICIT NONE 384 364 385 ! 1. Declaration of the type of variable which have to be interpolated 365 386 !--------------------------------------------------------------------- 366 Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/)) 367 Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/)) 368 Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/)) 369 370 ! 2. Space directions for each variables 371 !--------------------------------------- 372 Call Agrif_Set_raf(trn,(/'x','y','N','N'/)) 373 Call Agrif_Set_raf(trb,(/'x','y','N','N'/)) 374 Call Agrif_Set_raf(tra,(/'x','y','N','N'/)) 375 376 ! 3. Type of interpolation 377 !------------------------- 378 Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear) 379 Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear) 380 381 ! 4. Location of interpolation 387 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/), & 388 & (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 389 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/), & 390 & (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 391 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0,jptra/),(/'x','y','N','N'/), & 392 & (/1,1,1,1/),(/jpi,jpj,jpk/),tra_id) 393 394 # if defined key_offline 395 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 396 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 397 # endif 398 399 ! 2. Type of interpolation 400 !------------------------- 401 CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 402 CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear) 403 404 # if defined key_offline 405 Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 406 Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 407 # endif 408 409 ! 3. Location of interpolation 382 410 !----------------------------- 383 Call Agrif_Set_bc(trn,(/0,1/)) 384 Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) 411 # if defined key_offline 412 Call Agrif_Set_bc(e1u_id,(/0,0/)) 413 Call Agrif_Set_bc(e2v_id,(/0,0/)) 414 # endif 415 Call Agrif_Set_bc(trn_id,(/0,1/)) 416 Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 385 417 386 418 ! 5. Update type 387 419 !--------------- 388 Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average) 389 Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average) 390 391 ! 6. First interpolations of potentially non zero fields 392 !------------------------------------------------------- 393 Agrif_SpecialValue=0. 394 Agrif_UseSpecialValue = .TRUE. 395 Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 396 Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 397 Agrif_UseSpecialValue = .FALSE. 398 399 ! 7. Some controls 400 !----------------- 401 check_namelist = .true. 402 403 IF( check_namelist ) THEN 404 405 ! Check time steps 406 IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 407 WRITE(*,*) 'incompatible time step between grids' 408 WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 409 WRITE(*,*) 'child grid value : ',nint(rdt) 410 WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 411 STOP 412 ENDIF 413 414 ! Check run length 415 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 416 Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 417 WRITE(*,*) 'incompatible run length between grids' 418 WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 419 Agrif_Parent(nit000)+1),' time step' 420 WRITE(*,*) 'child grid value : ', & 421 (nitend-nit000+1),' time step' 422 WRITE(*,*) 'value on child grid should be : ', & 423 Agrif_IRhot() * (Agrif_Parent(nitend)- & 424 Agrif_Parent(nit000)+1) 425 STOP 426 ENDIF 427 428 ! Check coordinates 429 IF( ln_zps ) THEN 430 ! check parameters for partial steps 431 IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 432 WRITE(*,*) 'incompatible e3zps_min between grids' 433 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 434 WRITE(*,*) 'child grid :',e3zps_min 435 WRITE(*,*) 'those values should be identical' 436 STOP 437 ENDIF 438 IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 439 WRITE(*,*) 'incompatible e3zps_rat between grids' 440 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 441 WRITE(*,*) 'child grid :',e3zps_rat 442 WRITE(*,*) 'those values should be identical' 443 STOP 444 ENDIF 445 ENDIF 446 ! Check passive tracer cell 447 IF( nn_dttrc .ne. 1 ) THEN 448 WRITE(*,*) 'nn_dttrc should be equal to 1' 449 ENDIF 450 451 ENDIF 452 453 CALL Agrif_Update_trc(0) 454 nbcline_trc = 0 455 ! 456 END SUBROUTINE Agrif_InitValues 457 458 #endif 459 460 SUBROUTINE Agrif_detect( g, sizex ) 420 Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 421 Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 422 423 # if defined key_offline 424 Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 425 Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 426 # endif 427 428 END SUBROUTINE agrif_declare_var_top 429 # endif 430 431 SUBROUTINE Agrif_detect( kg, ksizex ) 461 432 !!---------------------------------------------------------------------- 462 433 !! *** ROUTINE Agrif_detect *** 463 434 !!---------------------------------------------------------------------- 464 435 USE Agrif_Types 465 ! !466 INTEGER, DIMENSION(2) :: sizex467 INTEGER, DIMENSION( sizex(1),sizex(2)) ::g436 ! 437 INTEGER, DIMENSION(2) :: ksizex 438 INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 468 439 !!---------------------------------------------------------------------- 469 440 ! … … 479 450 USE agrif_oce 480 451 USE in_out_manager 481 !!482 IMPLICIT NONE 483 ! !452 USE lib_mpp 453 IMPLICIT NONE 454 ! 484 455 NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 485 456 !!---------------------------------------------------------------------- … … 505 476 visc_dyn = rn_sponge_dyn 506 477 ! 478 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 479 ! 507 480 END SUBROUTINE agrif_nemo_init 508 481 … … 514 487 !!---------------------------------------------------------------------- 515 488 USE dom_oce 516 !! 517 IMPLICIT NONE 518 !! 519 INTEGER :: indglob,indloc,nprocloc,i 489 IMPLICIT NONE 490 ! 491 INTEGER :: indglob, indloc, nprocloc, i 520 492 !!---------------------------------------------------------------------- 521 493 ! … … 534 506 SUBROUTINE Subcalledbyagrif 535 507 !!---------------------------------------------------------------------- 536 !! *** ROUTINE Subcalledbyagrif ***508 !! *** ROUTINE Subcalledbyagrif *** 537 509 !!---------------------------------------------------------------------- 538 510 WRITE(*,*) 'Impossible to be here'
Note: See TracChangeset
for help on using the changeset viewer.