#if defined key_agrif !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $Id: agrif_user.F90 1605 2009-08-11 12:33:40Z ctlod $ !! 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/nammpp_dyndist/ jpni, jpnj, jpnij #endif !!---------------------------------------------------------------------- #if defined key_mpp_dyndist ! MPP dynamical distribution : read the processor cutting in the namelist IF( Agrif_Nbstepint() == 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,nammpp_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 #if ! defined key_off_tra 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 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) #if defined key_top nbcline_trc = 0 #endif nbcline = 0 ! END SUBROUTINE Agrif_InitValues #else SUBROUTINE Agrif_InitValues !!---------------------------------------------------------------------- !! *** ROUTINE Agrif_InitValues *** !! !! ** Purpose :: Declaration of variables to be interpolated !!---------------------------------------------------------------------- USE Agrif_Util USE oce USE dom_oce USE opa USE trc USE in_out_manager USE agrif_top_update USE agrif_top_interp USE agrif_top_sponge !! IMPLICIT NONE !! REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 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 ! 1. Declaration of the type of variable which have to be interpolated !--------------------------------------------------------------------- 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/)) ! 2. Space directions for each variables !--------------------------------------- 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'/)) ! 3. Type of interpolation !------------------------- Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear) Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear) ! 4. Location of interpolation !----------------------------- Call Agrif_Set_bc(trn,(/0,1/)) Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) ! 5. Update type !--------------- Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average) Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average) ! 6. First interpolations of potentially non zero fields !------------------------------------------------------- Agrif_SpecialValue=0. Agrif_UseSpecialValue = .TRUE. Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 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 ! Check passive tracer cell IF( ndttrc .ne. 1 ) THEN WRITE(*,*) 'ndttrc should be equal to 1' ENDIF ENDIF CALL Agrif_Update_trc(0) nbcline_trc = 0 ! END SUBROUTINE Agrif_InitValues #endif 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/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn !!---------------------------------------------------------------------- REWIND( numnam ) ! Read namagrif namelist READ ( numnam, namagrif ) ! IF(lwp) THEN ! control print WRITE(numout,*) WRITE(numout,*) 'agrif_opa_init : AGRIF parameters' WRITE(numout,*) '~~~~~~~~~~~~' WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' WRITE(numout,*) ' baroclinic update frequency nn_cln_update = ', nn_cln_update WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' s' WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' s' WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn WRITE(numout,*) ENDIF ! ! convert DOCTOR namelist name into OLD names nbclineupdate = nn_cln_update visc_tra = rn_sponge_tra visc_dyn = rn_sponge_dyn ! 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