Skip to content
Snippets Groups Projects
agrif_user.F90 57.2 KiB
Newer Older
Guillaume Samson's avatar
Guillaume Samson committed
#if defined key_agrif
   SUBROUTINE agrif_user()
      !!----------------------------------------------------------------------
      !!                 *** ROUTINE agrif_user ***
      !!----------------------------------------------------------------------
   END SUBROUTINE agrif_user

   SUBROUTINE agrif_initworkspace()
      !!----------------------------------------------------------------------
      !!                 *** ROUTINE Agrif_InitWorkspace ***
      !!----------------------------------------------------------------------
   END SUBROUTINE agrif_initworkspace

   SUBROUTINE Agrif_InitValues
      !!----------------------------------------------------------------------
      !!                 *** ROUTINE Agrif_InitValues ***
      !!
      !! ** Purpose :: Declaration of variables to be interpolated
      !!----------------------------------------------------------------------
      USE Agrif_Util
      USE dom_oce
      USE nemogcm
      USE domain
      !!
      IMPLICIT NONE

      ! No temporal refinement
      CALL Agrif_Set_coeffreft(1)

      CALL nemo_init       !* Initializations of each fine grid

      CALL dom_nam

   END SUBROUTINE Agrif_InitValues

   SUBROUTINE Agrif_InitValues_cont
      !!----------------------------------------------------------------------
      !!                 *** ROUTINE Agrif_InitValues_cont ***
      !!
      !! ** Purpose :: Initialisation of variables to be interpolated
      !!----------------------------------------------------------------------
      USE dom_oce
      USE lbclnk
      !!
      IMPLICIT NONE
      !
      INTEGER :: irafx, irafy
      LOGICAL :: ln_perio, ldIperio, ldNFold, l_deg
      !
      irafx = agrif_irhox()
      irafy = agrif_irhoy()


   !       IF(jperio /=1 .AND. jperio/=4 .AND. jperio/=6 ) THEN
   !          nx = (nbcellsx)+2*nbghostcellsfine+2
   !          ny = (nbcellsy)+2*nbghostcellsfine+2
   !          nbghostcellsfine_tot_x= nbghostcellsfine_x +1
   !          nbghostcellsfine_tot_y= nbghostcellsfine_y +1
   !       ELSE
   !         nx = (nbcellsx)+2*nbghostcellsfine_x
   !         ny = (nbcellsy)+2*nbghostcellsfine+2
   !         nbghostcellsfine_tot_x= 1
   !         nbghostcellsfine_tot_y= nbghostcellsfine_y +1
   !      ENDIF
   !    ELSE
   !       nbghostcellsfine = 0
   !       nx = nbcellsx+irafx
   !       ny = nbcellsy+irafy

      WRITE(*,*) ' '
      WRITE(*,*)'Size of the High resolution grid: ',jpi,' x ',jpj
      WRITE(*,*) ' '
      ln_perio = .FALSE.
      l_deg = .TRUE.

      ldIperio = (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
      ldNFold  = jperio >= 3 .AND. jperio <= 6 
      IF( ldIperio.OR.ldNFold ) ln_perio=.TRUE.
      IF ( Agrif_Parent(jphgr_msh)==2 &
      &.OR.Agrif_Parent(jphgr_msh)==3 & 
      &.OR.Agrif_Parent(jphgr_msh)==5 ) l_deg = .FALSE.

      CALL agrif_init_lonlat()
    
      IF ( l_deg ) THEN
         WHERE (glamt < -180) glamt = glamt +360.
         WHERE (glamt > +180) glamt = glamt -360.
         WHERE (glamu < -180) glamu = glamu +360.
         WHERE (glamu > +180) glamu = glamu -360.
         WHERE (glamv < -180) glamv = glamv +360.
         WHERE (glamv > +180) glamv = glamv -360.
         WHERE (glamf < -180) glamf = glamf +360.
         WHERE (glamf > +180) glamf = glamf -360.
      ENDIF

      CALL lbc_lnk( 'glamt', glamt, 'T', 1._wp)
      CALL lbc_lnk( 'gphit', gphit, 'T', 1._wp)

      CALL lbc_lnk( 'glamu', glamu, 'U', 1._wp)
      CALL lbc_lnk( 'gphiu', gphiu, 'U', 1._wp)

      CALL lbc_lnk( 'glamv', glamv, 'V', 1._wp)
      CALL lbc_lnk( 'gphiv', gphiv, 'V', 1._wp)

      CALL lbc_lnk( 'glamf', glamf, 'F', 1._wp)
      CALL lbc_lnk( 'gphif', gphif, 'F', 1._wp)

      ! Correct South and North
      IF ((.not.lk_south).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
         glamt(:,1+nn_hls) = glamt(:,2+nn_hls)
         gphit(:,1+nn_hls) = gphit(:,2+nn_hls)
         glamu(:,1+nn_hls) = glamu(:,2+nn_hls)
         gphiu(:,1+nn_hls) = gphiu(:,2+nn_hls)
      ENDIF
      !South:
      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
         gphif(:,nn_hls) = gphif(:,1+nn_hls) 
         glamf(:,nn_hls) = glamf(:,1+nn_hls) 
      ENDIF 

      IF ( .NOT.ldNFold ) THEN
         IF ((.not.lk_north).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
            glamt(:,jpj-nn_hls) = glamt(:,jpj-nn_hls-1)
            gphit(:,jpj-nn_hls) = gphit(:,jpj-nn_hls-1)
            glamu(:,jpj-nn_hls) = glamu(:,jpj-nn_hls-1)
            gphiu(:,jpj-nn_hls) = gphiu(:,jpj-nn_hls-1)
            glamv(:,jpj-nn_hls) = glamv(:,jpj-nn_hls-1)
            gphiv(:,jpj-nn_hls) = gphiv(:,jpj-nn_hls-1)
            glamf(:,jpj-nn_hls) = glamf(:,jpj-nn_hls-1)
            gphif(:,jpj-nn_hls) = gphif(:,jpj-nn_hls-1)
         ENDIF
      ENDIF
      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
         glamf(:,jpj-nn_hls+1) = glamf(:,jpj-nn_hls)
         gphif(:,jpj-nn_hls+1) = gphif(:,jpj-nn_hls)
      ENDIF

      ! Correct West and East
      IF( .NOT.ldIperio ) THEN
         IF((nbondi == -1) .OR. (nbondi == 2) ) THEN
            glamt(1+nn_hls,:) = glamt(2+nn_hls,:)
            gphit(1+nn_hls,:) = gphit(2+nn_hls,:)
            glamv(1+nn_hls,:) = glamv(2+nn_hls,:)
            gphiv(1+nn_hls,:) = gphiv(2+nn_hls,:)
         ENDIF
         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
            glamt(jpi-nn_hls,:) = glamt(jpi-nn_hls-1,:)
            gphit(jpi-nn_hls,:) = gphit(jpi-nn_hls-1,:)
            glamu(jpi-nn_hls,:) = glamu(jpi-nn_hls-1,:)
            gphiu(jpi-nn_hls,:) = gphiu(jpi-nn_hls-1,:)
            glamv(jpi-nn_hls,:) = glamv(jpi-nn_hls-1,:)
            gphiv(jpi-nn_hls,:) = gphiv(jpi-nn_hls-1,:)
            glamf(jpi-nn_hls,:) = glamf(jpi-nn_hls-1,:)
            gphif(jpi-nn_hls,:) = gphif(jpi-nn_hls-1,:)
         ENDIF
      ENDIF
      IF((nbondi == -1) .OR. (nbondi == 2) ) THEN
         gphif(nn_hls,:) = gphif(nn_hls+1,:)
         glamf(nn_hls,:) = glamf(nn_hls+1,:)
      ENDIF
      IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
         glamf(jpi-nn_hls+1,:) = glamf(jpi-nn_hls,:)
         gphif(jpi-nn_hls+1,:) = gphif(jpi-nn_hls,:)
      ENDIF

      CALL agrif_init_scales()

      ! Fill ghost points in case of closed boundaries:
      ! Correct South and North
      IF ((.NOT.lk_south).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
         e1t(:,1+nn_hls) = e1t(:,2+nn_hls)
         e2t(:,1+nn_hls) = e2t(:,2+nn_hls)
         e1u(:,1+nn_hls) = e1u(:,2+nn_hls)
         e2u(:,1+nn_hls) = e2u(:,2+nn_hls)
      ENDIF
      IF ( .NOT.ldNFold ) THEN
         IF((.NOT.lk_north).AND.((nbondj == 1) .OR. (nbondj == 2) )) THEN
            e1t(:,jpj-nn_hls) = e1t(:,jpj-nn_hls-1)
            e2t(:,jpj-nn_hls) = e2t(:,jpj-nn_hls-1)
            e1u(:,jpj-nn_hls) = e1u(:,jpj-nn_hls-1)
            e2u(:,jpj-nn_hls) = e2u(:,jpj-nn_hls-1)
            e1v(:,jpj-nn_hls) = e1v(:,jpj-nn_hls-1)
            e2v(:,jpj-nn_hls) = e2v(:,jpj-nn_hls-1)
            e1f(:,jpj-nn_hls) = e1f(:,jpj-nn_hls-1)
            e2f(:,jpj-nn_hls) = e2f(:,jpj-nn_hls-1)
         ENDIF
      ENDIF

      ! Correct West and East
      IF( .NOT.ldIperio ) THEN
         IF((.NOT.lk_west).AND.(nbondj == -1).OR.(nbondj == 2) ) THEN
            e1t(1+nn_hls,:) = e1t(2+nn_hls,:)
            e2t(1+nn_hls,:) = e2t(2+nn_hls,:)
            e1v(1+nn_hls,:) = e1v(2+nn_hls,:)
            e2v(1+nn_hls,:) = e2v(2+nn_hls,:)
         ENDIF
         IF((.NOT.lk_east).AND.(nbondj == 1) .OR. (nbondj == 2) ) THEN
            e1t(jpi-nn_hls,:) = e1t(jpi-nn_hls-1,:)
            e2t(jpi-nn_hls,:) = e2t(jpi-nn_hls-1,:)
            e1u(jpi-nn_hls,:) = e1u(jpi-nn_hls-1,:)
Loading
Loading full blame...