Changeset 636 for trunk/NEMO/NST_SRC/agrif_user.F90
- Timestamp:
- 2007-03-07T14:28:16+01:00 (17 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/NST_SRC/agrif_user.F90
r628 r636 1 1 #if defined key_agrif 2 3 ! 4 ! Modules used: 5 ! 6 U separ_oce7 U sedom_oce2 SUBROUTINE Agrif_InitWorkspace 3 !!------------------------------------------ 4 !! *** ROUTINE Agrif_InitWorkspace *** 5 !!------------------------------------------ 6 USE par_oce 7 USE dom_oce 8 8 USE Agrif_Util 9 ! 10 ! Declarations: 11 ! 9 12 10 IMPLICIT NONE 13 ! 14 ! Variables 15 ! 16 17 ! 18 ! Begin 19 ! 20 if ( .NOT. Agrif_Root() ) then 11 12 #if defined key_mpp_dyndist 13 CHARACTER(len=20) :: namelistname 14 INTEGER nummpp 15 NAMELIST/nam_mpp_dyndist/jpni,jpnj,jpnij 16 17 IF (Agrif_Nbstepint() .EQ. 0) THEN 18 nummpp = Agrif_Get_Unit() 19 namelistname='namelist' 20 IF (.NOT. Agrif_Root()) namelistname=TRIM(Agrif_CFixed())//'_namelist' 21 OPEN(nummpp,file=namelistname,status='OLD',form='formatted') 22 READ (nummpp,nam_mpp_dyndist) 23 CLOSE(nummpp) 24 ENDIF 25 #endif 26 27 IF( .NOT. Agrif_Root() ) THEN 21 28 jpiglo = nbcellsx + 2 + 2*nbghostcells 22 29 jpjglo = nbcellsy + 2 + 2*nbghostcells … … 33 40 nperio = 0 34 41 jperio = 0 35 endif 36 37 38 Return 39 End Subroutine Agrif_InitWorkspace 40 41 ! 42 SUBROUTINE Agrif_InitValues 43 ! ------------------------------------------------------------------ 44 ! You should declare the variable which has to be interpolated here 45 ! ----------------------------------------------------------------- 46 ! 47 ! Modules used: 48 ! 42 ENDIF 43 44 END SUBROUTINE Agrif_InitWorkspace 45 46 ! 47 SUBROUTINE Agrif_InitValues 48 !!------------------------------------------ 49 !! *** ROUTINE Agrif_InitValues *** 50 !! 51 !! ** Purpose :: Declaration of variables to 52 !! be interpolated 53 !!------------------------------------------ 49 54 USE Agrif_Util 50 USE oce 55 USE oce 51 56 USE dom_oce 52 57 USE opa 53 #if defined key_tradmp || defined key_esopa 58 USE sms 59 #if defined key_tradmp || defined key_esopa 54 60 USE tradmp 55 61 #endif … … 59 65 USE ice_oce 60 66 #endif 61 #if defined key_passivetrc62 USE agrif_top_update63 USE agrif_top_interp64 USE sms65 #endif66 67 #if defined key_agrif 67 USE agrif_opa_update 68 USE agrif_opa_interp 69 USE agrif_opa_sponge 70 #endif 71 ! 72 ! Declarations: 73 ! 74 Implicit none 75 ! 76 ! Variables 77 ! 78 REAL(wp) tabtemp(jpi,jpj,jpk) 79 #if defined key_passivetrc 80 REAL(wp) tabtrtemp(jpi,jpj,jpk,jptra) 81 #endif 82 ! 68 USE agrif_opa_update 69 USE agrif_opa_interp 70 USE agrif_opa_sponge 71 USE agrif_top_update 72 USE agrif_top_interp 73 #endif 74 75 IMPLICIT NONE 76 77 REAL(wp) :: tabtemp(jpi,jpj,jpk) 78 #if defined key_passivetrc 79 REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 80 #endif 83 81 LOGICAL check_namelist 84 ! 85 ! 86 ! Begin 87 ! 82 83 ! 0. Initializations 84 !------------------- 88 85 #if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4 89 jp_cfg = -1 ! set special value for jp_cfg on fine grids86 jp_cfg = -1 ! set special value for jp_cfg on fine grids 90 87 cp_cfg = "default" 91 88 #endif 92 89 93 90 Call opa_init ! Initializations of each fine grid 94 ! 95 ! Specific fine grid Initializations 96 ! 91 92 ! Specific fine grid Initializations 97 93 #if defined key_tradmp || defined key_esopa 98 ! no tracer damping on fine grids94 ! no tracer damping on fine grids 99 95 lk_tradmp = .FALSE. 100 96 #endif 101 ! 102 ! Declaration of the type of variable which have to be interpolated 103 ! 97 ! 1. Declaration of the type of variable which have to be interpolated 98 !--------------------------------------------------------------------- 104 99 Call Agrif_Set_type(un,(/1,2,0/),(/2,3,0/)) 105 100 Call Agrif_Set_type(vn,(/2,1,0/),(/3,2,0/)) … … 110 105 Call Agrif_Set_type(e1u,(/1,2/),(/2,3/)) 111 106 Call Agrif_Set_type(e2v,(/2,1/),(/3,2/)) 112 107 113 108 Call Agrif_Set_type(tn,(/2,2,0/),(/3,3,0/)) 114 109 Call Agrif_Set_type(sn,(/2,2,0/),(/3,3,0/)) … … 116 111 Call Agrif_Set_type(tb,(/2,2,0/),(/3,3,0/)) 117 112 Call Agrif_Set_type(sb,(/2,2,0/),(/3,3,0/)) 118 113 119 114 Call Agrif_Set_type(ta,(/2,2,0/),(/3,3,0/)) 120 115 Call Agrif_Set_type(sa,(/2,2,0/),(/3,3,0/)) 121 116 122 117 Call Agrif_Set_type(sshn,(/2,2/),(/3,3/)) 123 118 Call Agrif_Set_type(gcb,(/2,2/),(/3,3/)) … … 128 123 Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/)) 129 124 #endif 130 131 132 133 ! 134 ! Space directions for each variables 135 ! 125 126 ! 2. Space directions for each variables 127 !--------------------------------------- 136 128 Call Agrif_Set_raf(un,(/'x','y','N'/)) 137 129 Call Agrif_Set_raf(vn,(/'x','y','N'/)) 138 130 139 131 Call Agrif_Set_raf(ua,(/'x','y','N'/)) 140 132 Call Agrif_Set_raf(va,(/'x','y','N'/)) … … 145 137 Call Agrif_Set_raf(tn,(/'x','y','N'/)) 146 138 Call Agrif_Set_raf(sn,(/'x','y','N'/)) 147 139 148 140 Call Agrif_Set_raf(tb,(/'x','y','N'/)) 149 141 Call Agrif_Set_raf(sb,(/'x','y','N'/)) 150 142 151 143 Call Agrif_Set_raf(ta,(/'x','y','N'/)) 152 144 Call Agrif_Set_raf(sa,(/'x','y','N'/)) 153 145 154 146 Call Agrif_Set_raf(sshn,(/'x','y'/)) 155 147 Call Agrif_Set_raf(gcb,(/'x','y'/)) … … 161 153 #endif 162 154 163 ! 164 ! type of interpolation 165 155 ! 3. Type of interpolation 156 !------------------------- 166 157 Call Agrif_Set_bcinterp(tn,interp=AGRIF_linear) 167 158 Call Agrif_Set_bcinterp(sn,interp=AGRIF_linear) 168 159 169 160 Call Agrif_Set_bcinterp(ta,interp=AGRIF_linear) 170 161 Call Agrif_Set_bcinterp(sa,interp=AGRIF_linear) 171 162 172 163 Call Agrif_Set_bcinterp(un,interp1=Agrif_linear,interp2=AGRIF_ppm) 173 164 Call Agrif_Set_bcinterp(vn,interp1=AGRIF_ppm,interp2=Agrif_linear) … … 175 166 Call Agrif_Set_bcinterp(ua,interp1=Agrif_linear,interp2=AGRIF_ppm) 176 167 Call Agrif_Set_bcinterp(va,interp1=AGRIF_ppm,interp2=Agrif_linear) 177 168 178 169 Call Agrif_Set_bcinterp(e1u,interp1=Agrif_linear,interp2=AGRIF_ppm) 179 170 Call Agrif_Set_bcinterp(e2v,interp1=AGRIF_ppm,interp2=Agrif_linear) … … 184 175 #endif 185 176 186 ! 187 ! Location of interpolation 188 ! 177 ! 4. Location of interpolation 178 !----------------------------- 189 179 Call Agrif_Set_bc(un,(/0,1/)) 190 180 Call Agrif_Set_bc(vn,(/0,1/)) 191 181 192 182 Call Agrif_Set_bc(e1u,(/0,0/)) 193 183 Call Agrif_Set_bc(e2v,(/0,0/)) … … 207 197 #endif 208 198 209 !Update type210 199 ! 5. Update type 200 !--------------- 211 201 Call Agrif_Set_Updatetype(tn, update = AGRIF_Update_Average) 212 202 Call Agrif_Set_Updatetype(sn, update = AGRIF_Update_Average) 213 203 214 204 Call Agrif_Set_Updatetype(tb, update = AGRIF_Update_Average) 215 205 Call Agrif_Set_Updatetype(sb, update = AGRIF_Update_Average) … … 229 219 Call Agrif_Set_Updatetype(e2v,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 230 220 231 ! First interpolations of potentially non zero fields 232 233 Agrif_SpecialValue=0. 234 Agrif_UseSpecialValue = .TRUE. 235 Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.) 236 Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.) 237 Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu) 238 Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv) 239 240 Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn) 241 Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn) 242 243 Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun) 244 Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn) 245 246 #if defined key_passivetrc 247 Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 248 ! Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 249 Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.) 250 251 #endif 252 Agrif_UseSpecialValue = .FALSE. 253 254 ! 255 256 ! 221 ! 6. First interpolations of potentially non zero fields 222 !------------------------------------------------------- 223 Agrif_SpecialValue=0. 224 Agrif_UseSpecialValue = .TRUE. 225 Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.) 226 Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.) 227 Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu) 228 Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv) 229 230 Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn) 231 Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn) 232 233 Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun) 234 Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn) 235 236 #if defined key_passivetrc 237 Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 238 Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.) 239 #endif 240 Agrif_UseSpecialValue = .FALSE. 241 242 ! 7. Some controls 243 !----------------- 257 244 check_namelist = .true. 258 ! 259 IF( check_namelist ) then 260 ! 261 ! check time steps 262 ! 263 If( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) then 264 Write(*,*) 'incompatible time step between grids' 265 Write(*,*) 'parent grid value : ',Agrif_Parent(rdt) 266 Write(*,*) 'child grid value : ',nint(rdt) 267 Write(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 268 stop 269 Endif 270 271 If( Agrif_IRhot() * (Agrif_Parent(nitend)- & 272 Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) then 273 Write(*,*) 'incompatible run length between grids' 274 Write(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 275 Agrif_Parent(nit000)+1),' time step' 276 Write(*,*) 'child grid value : ', & 277 (nitend-nit000+1),' time step' 278 Write(*,*) 'value on child grid should be : ', & 279 Agrif_IRhot() * (Agrif_Parent(nitend)- & 280 Agrif_Parent(nit000)+1) 281 stop 282 Endif 283 ! 284 ! 285 IF ( ln_zps ) THEN 286 ! 287 ! check parameters for partial steps 288 ! 289 If( Agrif_Parent(e3zps_min) .ne. e3zps_min ) then 290 Write(*,*) 'incompatible e3zps_min between grids' 291 Write(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 292 Write(*,*) 'child grid :',e3zps_min 293 Write(*,*) 'those values should be identical' 294 stop 295 Endif 296 ! 297 If( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) then 298 Write(*,*) 'incompatible e3zps_rat between grids' 299 Write(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 300 Write(*,*) 'child grid :',e3zps_rat 301 Write(*,*) 'those values should be identical' 302 stop 303 Endif 304 ENDIF 305 ! 245 246 IF( check_namelist ) THEN 247 248 ! Check time steps 249 IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 250 WRITE(*,*) 'incompatible time step between grids' 251 WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 252 WRITE(*,*) 'child grid value : ',nint(rdt) 253 WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 254 STOP 255 ENDIF 256 257 ! Check run length 258 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 259 Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 260 WRITE(*,*) 'incompatible run length between grids' 261 WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 262 Agrif_Parent(nit000)+1),' time step' 263 WRITE(*,*) 'child grid value : ', & 264 (nitend-nit000+1),' time step' 265 WRITE(*,*) 'value on child grid should be : ', & 266 Agrif_IRhot() * (Agrif_Parent(nitend)- & 267 Agrif_Parent(nit000)+1) 268 STOP 269 ENDIF 270 271 ! Check coordinates 272 IF( ln_zps ) THEN 273 ! check parameters for partial steps 274 IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 275 WRITE(*,*) 'incompatible e3zps_min between grids' 276 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 277 WRITE(*,*) 'child grid :',e3zps_min 278 WRITE(*,*) 'those values should be identical' 279 STOP 280 ENDIF 281 IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 282 WRITE(*,*) 'incompatible e3zps_rat between grids' 283 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 284 WRITE(*,*) 'child grid :',e3zps_rat 285 WRITE(*,*) 'those values should be identical' 286 STOP 287 ENDIF 288 ENDIF 289 306 290 ENDIF 307 ! 308 ! 309 310 Call Agrif_Update_tra(0) 311 Call Agrif_Update_dyn(0) 291 292 CALL Agrif_Update_tra(0) 293 CALL Agrif_Update_dyn(0) 294 295 nbcline = 0 296 297 END SUBROUTINE Agrif_InitValues 298 ! 299 300 SUBROUTINE Agrif_detect(g,sizex) 301 !!------------------------------------------ 302 !! *** ROUTINE Agrif_detect *** 303 !!------------------------------------------ 304 USE Agrif_Types 305 306 INTEGER, DIMENSION(2) :: sizex 307 INTEGER, DIMENSION(sizex(1),sizex(2)) :: g 308 309 Return 310 311 End SUBROUTINE Agrif_detect 312 313 #if defined key_mpp_mpi 314 315 SUBROUTINE Agrif_InvLoc(indloc,nprocloc,i,indglob) 316 !!------------------------------------------ 317 !! *** ROUTINE Agrif_detect *** 318 !!------------------------------------------ 319 USE dom_oce 312 320 313 nbcline = 0 314 315 Return 316 End Subroutine Agrif_InitValues 317 ! 318 SUBROUTINE Agrif_detect(g,sizex) 319 ! 320 ! Modules used: 321 ! 322 Use Agrif_Types 323 ! 324 ! 325 ! Declarations: 326 ! 327 ! 328 ! Variables 329 ! 330 Integer, Dimension(2) :: sizex 331 Integer, Dimension(sizex(1),sizex(2)) :: g 332 ! 333 ! Begin 334 ! 335 ! 336 337 ! 338 Return 339 End Subroutine Agrif_detect 340 341 #if defined key_mpp_mpi 342 ! 343 ! ************************************************************************** 344 !!! Subroutine Agrif_InvLoc 345 ! ************************************************************************** 346 ! 347 Subroutine Agrif_InvLoc(indloc,nprocloc,i,indglob) 348 ! 349 ! Description: 350 ! 351 USE dom_oce 352 353 ! Declarations: 354 ! 355 !! Implicit none 356 ! 357 Integer :: indglob,indloc,nprocloc,i 358 ! 359 ! 321 IMPLICIT NONE 322 323 INTEGER :: indglob,indloc,nprocloc,i 324 360 325 SELECT CASE(i) 361 362 326 CASE(1) 363 indglob = indloc + nimppt(nprocloc+1) - 1 364 327 indglob = indloc + nimppt(nprocloc+1) - 1 365 328 CASE(2) 366 indglob = indloc + njmppt(nprocloc+1) - 1 367 329 indglob = indloc + njmppt(nprocloc+1) - 1 368 330 CASE(3) 369 indglob = indloc 370 331 indglob = indloc 371 332 CASE(4) 372 indglob = indloc 373 333 indglob = indloc 374 334 END SELECT 375 ! 376 ! 377 End Subroutine Agrif_InvLoc 378 #endif 379 380 335 336 END SUBROUTINE Agrif_InvLoc 337 338 #endif 339 381 340 #else 382 subroutine Subcalledbyagrif 383 write(*,*) 'Impossible to bet here' 384 end subroutine Subcalledbyagrif 385 #endif 341 SUBROUTINE Subcalledbyagrif 342 !!------------------------------------------ 343 !! *** ROUTINE Subcalledbyagrif *** 344 !!------------------------------------------ 345 WRITE(*,*) 'Impossible to be here' 346 END SUBROUTINE Subcalledbyagrif 347 #endif
Note: See TracChangeset
for help on using the changeset viewer.