Changeset 1300 for trunk/NEMO/NST_SRC/agrif_user.F90

Timestamp:

2009-02-09T16:36:04+01:00 (15 years ago)

Author:

rblod

Message:

Correct a bug in TOP update part

File:

• trunk/NEMO/NST_SRC/agrif_user.F90 (modified) (2 diffs)

trunk/NEMO/NST_SRC/agrif_user.F90

@@ -51 +51 @@
 
    !
+#if ! defined key_off_tra
+
    SUBROUTINE Agrif_InitValues
       !!------------------------------------------
@@ -310 +312 @@
       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)