#if defined key_agrif !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- SUBROUTINE Agrif_InitWorkspace !!------------------------------------------ !! *** ROUTINE Agrif_InitWorkspace *** !!------------------------------------------ USE par_oce USE dom_oce USE Agrif_Util IMPLICIT NONE #if defined key_mpp_dyndist CHARACTER(len=20) :: namelistname INTEGER nummpp NAMELIST/nam_mpp_dyndist/jpni,jpnj,jpnij IF (Agrif_Nbstepint() .EQ. 0) THEN nummpp = Agrif_Get_Unit() namelistname='namelist' IF (.NOT. Agrif_Root()) namelistname=TRIM(Agrif_CFixed())//'_namelist' OPEN(nummpp,file=namelistname,status='OLD',form='formatted') READ (nummpp,nam_mpp_dyndist) CLOSE(nummpp) ENDIF #endif IF( .NOT. Agrif_Root() ) THEN jpiglo = nbcellsx + 2 + 2*nbghostcells jpjglo = nbcellsy + 2 + 2*nbghostcells jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj jpim1 = jpi-1 jpjm1 = jpj-1 jpkm1 = jpk-1 jpij = jpi*jpj jpidta = jpiglo jpjdta = jpjglo jpizoom = 1 jpjzoom = 1 nperio = 0 jperio = 0 ENDIF END SUBROUTINE Agrif_InitWorkspace ! SUBROUTINE Agrif_InitValues !!------------------------------------------ !! *** ROUTINE Agrif_InitValues *** !! !! ** Purpose :: Declaration of variables to !! be interpolated !!------------------------------------------ USE Agrif_Util USE oce USE dom_oce USE opa #if defined key_top USE trc #endif #if defined key_tradmp || defined key_esopa USE tradmp #endif USE sol_oce USE in_out_manager #if defined key_lim3 || defined key_lim2 USE ice_oce #endif USE agrif_opa_update USE agrif_opa_interp USE agrif_opa_sponge USE agrif_top_update USE agrif_top_interp USE agrif_top_sponge IMPLICIT NONE REAL(wp) :: tabtemp(jpi,jpj,jpk) #if defined key_top REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) #endif LOGICAL check_namelist ! 0. Initializations !------------------- #if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4 jp_cfg = -1 ! set special value for jp_cfg on fine grids cp_cfg = "default" #endif Call opa_init ! Initializations of each fine grid Call agrif_opa_init ! Specific fine grid Initializations #if defined key_tradmp || defined key_esopa ! no tracer damping on fine grids lk_tradmp = .FALSE. #endif ! 1. Declaration of the type of variable which have to be interpolated !--------------------------------------------------------------------- Call Agrif_Set_type(un,(/1,2,0/),(/2,3,0/)) Call Agrif_Set_type(vn,(/2,1,0/),(/3,2,0/)) Call Agrif_Set_type(ua,(/1,2,0/),(/2,3,0/)) Call Agrif_Set_type(va,(/2,1,0/),(/3,2,0/)) Call Agrif_Set_type(e1u,(/1,2/),(/2,3/)) Call Agrif_Set_type(e2v,(/2,1/),(/3,2/)) Call Agrif_Set_type(tn,(/2,2,0/),(/3,3,0/)) Call Agrif_Set_type(sn,(/2,2,0/),(/3,3,0/)) Call Agrif_Set_type(tb,(/2,2,0/),(/3,3,0/)) Call Agrif_Set_type(sb,(/2,2,0/),(/3,3,0/)) Call Agrif_Set_type(ta,(/2,2,0/),(/3,3,0/)) Call Agrif_Set_type(sa,(/2,2,0/),(/3,3,0/)) Call Agrif_Set_type(sshn,(/2,2/),(/3,3/)) Call Agrif_Set_type(gcb,(/2,2/),(/3,3/)) #if defined key_top Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/)) Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/)) Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/)) #endif ! 2. Space directions for each variables !--------------------------------------- Call Agrif_Set_raf(un,(/'x','y','N'/)) Call Agrif_Set_raf(vn,(/'x','y','N'/)) Call Agrif_Set_raf(ua,(/'x','y','N'/)) Call Agrif_Set_raf(va,(/'x','y','N'/)) Call Agrif_Set_raf(e1u,(/'x','y'/)) Call Agrif_Set_raf(e2v,(/'x','y'/)) Call Agrif_Set_raf(tn,(/'x','y','N'/)) Call Agrif_Set_raf(sn,(/'x','y','N'/)) Call Agrif_Set_raf(tb,(/'x','y','N'/)) Call Agrif_Set_raf(sb,(/'x','y','N'/)) Call Agrif_Set_raf(ta,(/'x','y','N'/)) Call Agrif_Set_raf(sa,(/'x','y','N'/)) Call Agrif_Set_raf(sshn,(/'x','y'/)) Call Agrif_Set_raf(gcb,(/'x','y'/)) #if defined key_top Call Agrif_Set_raf(trn,(/'x','y','N','N'/)) Call Agrif_Set_raf(trb,(/'x','y','N','N'/)) Call Agrif_Set_raf(tra,(/'x','y','N','N'/)) #endif ! 3. Type of interpolation !------------------------- Call Agrif_Set_bcinterp(tn,interp=AGRIF_linear) Call Agrif_Set_bcinterp(sn,interp=AGRIF_linear) Call Agrif_Set_bcinterp(ta,interp=AGRIF_linear) Call Agrif_Set_bcinterp(sa,interp=AGRIF_linear) Call Agrif_Set_bcinterp(un,interp1=Agrif_linear,interp2=AGRIF_ppm) Call Agrif_Set_bcinterp(vn,interp1=AGRIF_ppm,interp2=Agrif_linear) Call Agrif_Set_bcinterp(ua,interp1=Agrif_linear,interp2=AGRIF_ppm) Call Agrif_Set_bcinterp(va,interp1=AGRIF_ppm,interp2=Agrif_linear) Call Agrif_Set_bcinterp(e1u,interp1=Agrif_linear,interp2=AGRIF_ppm) Call Agrif_Set_bcinterp(e2v,interp1=AGRIF_ppm,interp2=Agrif_linear) #if defined key_top Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear) Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear) #endif ! 4. Location of interpolation !----------------------------- Call Agrif_Set_bc(un,(/0,1/)) Call Agrif_Set_bc(vn,(/0,1/)) Call Agrif_Set_bc(e1u,(/0,0/)) Call Agrif_Set_bc(e2v,(/0,0/)) Call Agrif_Set_bc(tn,(/0,1/)) Call Agrif_Set_bc(sn,(/0,1/)) Call Agrif_Set_bc(ta,(/-3*Agrif_irhox(),0/)) Call Agrif_Set_bc(sa,(/-3*Agrif_irhox(),0/)) Call Agrif_Set_bc(ua,(/-2*Agrif_irhox(),0/)) Call Agrif_Set_bc(va,(/-2*Agrif_irhox(),0/)) #if defined key_top Call Agrif_Set_bc(trn,(/0,1/)) Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) #endif ! 5. Update type !--------------- Call Agrif_Set_Updatetype(tn, update = AGRIF_Update_Average) Call Agrif_Set_Updatetype(sn, update = AGRIF_Update_Average) Call Agrif_Set_Updatetype(tb, update = AGRIF_Update_Average) Call Agrif_Set_Updatetype(sb, update = AGRIF_Update_Average) Call Agrif_Set_Updatetype(sshn, update = AGRIF_Update_Average) Call Agrif_Set_Updatetype(gcb,update = AGRIF_Update_Average) #if defined key_top Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average) Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average) #endif Call Agrif_Set_Updatetype(un,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) Call Agrif_Set_Updatetype(vn,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) Call Agrif_Set_Updatetype(e1u,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) Call Agrif_Set_Updatetype(e2v,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) ! 6. First interpolations of potentially non zero fields !------------------------------------------------------- Agrif_SpecialValue=0. Agrif_UseSpecialValue = .TRUE. Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.) Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.) Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu) Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv) Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn) Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn) Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun) Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn) #if defined key_top Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) #endif Agrif_UseSpecialValue = .FALSE. ! 7. Some controls !----------------- check_namelist = .true. IF( check_namelist ) THEN ! Check time steps IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN WRITE(*,*) 'incompatible time step between grids' WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) WRITE(*,*) 'child grid value : ',nint(rdt) WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() STOP ENDIF ! Check run length IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN WRITE(*,*) 'incompatible run length between grids' WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & Agrif_Parent(nit000)+1),' time step' WRITE(*,*) 'child grid value : ', & (nitend-nit000+1),' time step' WRITE(*,*) 'value on child grid should be : ', & Agrif_IRhot() * (Agrif_Parent(nitend)- & Agrif_Parent(nit000)+1) STOP ENDIF ! Check coordinates IF( ln_zps ) THEN ! check parameters for partial steps IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN WRITE(*,*) 'incompatible e3zps_min between grids' WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) WRITE(*,*) 'child grid :',e3zps_min WRITE(*,*) 'those values should be identical' STOP ENDIF IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN WRITE(*,*) 'incompatible e3zps_rat between grids' WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) WRITE(*,*) 'child grid :',e3zps_rat WRITE(*,*) 'those values should be identical' STOP ENDIF ENDIF #if defined key_top ! Check passive tracer cell IF( ndttrc .ne. 1 ) THEN WRITE(*,*) 'ndttrc should be equal to 1' ENDIF #endif ENDIF #if defined key_top CALL Agrif_Update_trc(0) #endif CALL Agrif_Update_tra(0) CALL Agrif_Update_dyn(0) nbcline = 0 END SUBROUTINE Agrif_InitValues ! SUBROUTINE Agrif_detect(g,sizex) !!------------------------------------------ !! *** ROUTINE Agrif_detect *** !!------------------------------------------ USE Agrif_Types INTEGER, DIMENSION(2) :: sizex INTEGER, DIMENSION(sizex(1),sizex(2)) :: g Return End SUBROUTINE Agrif_detect SUBROUTINE agrif_opa_init !!--------------------------------------------- !! *** ROUTINE agrif_init *** !!--------------------------------------------- USE agrif_oce USE in_out_manager IMPLICIT NONE NAMELIST/namagrif/ nbclineupdate, visc_tra, visc_dyn, ln_spc_dyn REWIND ( numnam ) READ ( numnam, namagrif ) IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'agrif_opa_init : agrif parameters' WRITE(numout,*) '~~~~~~~~~~~~' WRITE(numout,*) ' Namelist namagrif : set agrif parameters' WRITE(numout,*) ' baroclinic update frequency = ', nbclineupdate WRITE(numout,*) ' sponge coefficient for tracers = ', visc_tra WRITE(numout,*) ' sponge coefficient for dynamics = ', visc_dyn WRITE(numout,*) ' use special values for dynamics = ', ln_spc_dyn WRITE(numout,*) ENDIF END SUBROUTINE agrif_opa_init #if defined key_mpp_mpi SUBROUTINE Agrif_InvLoc(indloc,nprocloc,i,indglob) !!------------------------------------------ !! *** ROUTINE Agrif_detect *** !!------------------------------------------ USE dom_oce IMPLICIT NONE INTEGER :: indglob,indloc,nprocloc,i SELECT CASE(i) CASE(1) indglob = indloc + nimppt(nprocloc+1) - 1 CASE(2) indglob = indloc + njmppt(nprocloc+1) - 1 CASE(3) indglob = indloc CASE(4) indglob = indloc END SELECT END SUBROUTINE Agrif_InvLoc #endif #else SUBROUTINE Subcalledbyagrif !!------------------------------------------ !! *** ROUTINE Subcalledbyagrif *** !!------------------------------------------ WRITE(*,*) 'Impossible to be here' END SUBROUTINE Subcalledbyagrif #endif