source: trunk/NEMO/NST_SRC/agrif_user.F90 @ 699

   !!----------------------------------------------------------------------
   !! $Id$
   !!----------------------------------------------------------------------
#if defined key_agrif
   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
      USE sms
#if defined key_tradmp   ||   defined key_esopa
      USE tradmp
#endif
      USE sol_oce
      USE in_out_manager
#if defined key_ice_lim
      USE ice_oce
#endif
#if defined key_agrif
      USE agrif_opa_update
      USE agrif_opa_interp
      USE agrif_opa_sponge
      USE agrif_top_update
      USE agrif_top_interp
#endif

      IMPLICIT NONE

      REAL(wp) :: tabtemp(jpi,jpj,jpk)
#if defined key_passivetrc
      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

      ! 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_passivetrc
      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_passivetrc
      Call Agrif_Set_raf(trb,(/'x','y','N','N'/))
      Call Agrif_Set_raf(trn,(/'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_passivetrc
      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_passivetrc
      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_passivetrc
      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_passivetrc
      Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.)
      Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.)
#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

      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

#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