Changeset 1300


Ignore:
Timestamp:
2009-02-09T16:36:04+01:00 (12 years ago)
Author:
rblod
Message:

Correct a bug in TOP update part

Location:
trunk/NEMO/NST_SRC
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/NST_SRC/agrif_opa_interp.F90

    r1156 r1300  
    11MODULE agrif_opa_interp 
    2 #if defined key_agrif 
     2#if defined key_agrif && ! defined key_off_tra 
    33   USE par_oce 
    44   USE oce 
  • trunk/NEMO/NST_SRC/agrif_opa_sponge.F90

    r1156 r1300  
    22 
    33Module agrif_opa_sponge 
    4 #if defined key_agrif 
     4#if defined key_agrif  && ! defined key_off_tra 
    55   USE par_oce 
    66   USE oce 
  • trunk/NEMO/NST_SRC/agrif_opa_update.F90

    r1200 r1300  
    22 
    33MODULE agrif_opa_update 
    4 #if defined key_agrif 
     4#if defined key_agrif  && ! defined key_off_tra 
    55   USE par_oce 
    66   USE oce 
     
    1313   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn 
    1414 
    15    INTEGER :: nbcline 
     15   INTEGER, PUBLIC :: nbcline = 0 
    1616 
    1717   !!---------------------------------------------------------------------- 
  • trunk/NEMO/NST_SRC/agrif_top_update.F90

    r1271 r1300  
    1515   PUBLIC Agrif_Update_Trc 
    1616 
    17    INTEGER :: nbcline 
     17   INTEGER, PUBLIC :: nbcline_trc = 0 
    1818 
    1919   !!---------------------------------------------------------------------- 
     
    3939      Agrif_SpecialValueFineGrid = 0. 
    4040  
    41      IF (MOD(nbcline,nbclineupdate) == 0) THEN 
     41     IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 
    4242         CALL Agrif_Update_Variable(ztra,trn, procname=updateTRC) 
    4343      ELSE 
     
    4646 
    4747      Agrif_UseSpecialValueInUpdate = .FALSE. 
     48      nbcline_trc = nbcline_trc + 1 
    4849#endif 
    4950 
    5051   END SUBROUTINE Agrif_Update_Trc 
    5152 
    52    SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,before) 
     53   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,l1,l2,before) 
    5354      !!--------------------------------------------- 
    5455      !!   *** ROUTINE UpdateTrc *** 
     
    5657#  include "domzgr_substitute.h90" 
    5758 
    58       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    59       REAL, DIMENSION(i1:i2,j1:j2,k1:k2,jptra), INTENT(inout) :: tabres 
     59      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 
     60      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 
    6061      LOGICAL, INTENT(in) :: before 
    6162    
    62       INTEGER :: ji,jj,jk,jn 
    63  
    64       DO jn=1, jptra   
     63      INTEGER :: ji,jj,jk,jl 
    6564 
    6665         IF (before) THEN 
    67             DO jk=k1,k2 
    68                DO jj=j1,j2 
    69                   DO ji=i1,i2 
    70                      tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     66            DO jl=l1,l2 
     67               DO jk=k1,k2 
     68                  DO jj=j1,j2 
     69                     DO ji=i1,i2 
     70                        tabres(ji,jj,jk,jl) = trn(ji,jj,jk,jl) 
     71                     ENDDO 
    7172                  ENDDO 
    7273               ENDDO 
    7374            ENDDO 
    7475         ELSE 
    75             DO jk=k1,k2 
    76                DO jj=j1,j2 
    77                   DO ji=i1,i2 
    78                      IF (tabres(ji,jj,jk,jn).NE.0.) THEN 
    79                         trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
    80                      ENDIF 
     76            DO jl=l1,l2 
     77               DO jk=k1,k2 
     78                  DO jj=j1,j2 
     79                     DO ji=i1,i2 
     80                        IF (tabres(ji,jj,jk,jl).NE.0.) THEN 
     81                           trn(ji,jj,jk,jl) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk) 
     82                        ENDIF 
     83                     ENDDO 
    8184                  ENDDO 
    8285               ENDDO 
    8386            ENDDO 
    8487         ENDIF 
    85  
    86       END DO 
    8788 
    8889   END SUBROUTINE updateTRC 
  • trunk/NEMO/NST_SRC/agrif_user.F90

    r1271 r1300  
    5151 
    5252   ! 
     53#if ! defined key_off_tra 
     54 
    5355   SUBROUTINE Agrif_InitValues 
    5456      !!------------------------------------------ 
     
    310312      CALL Agrif_Update_dyn(0) 
    311313 
     314#if defined key_top 
     315      nbcline_trc = 0 
     316#endif 
    312317      nbcline = 0 
    313318 
    314319   END SUBROUTINE Agrif_InitValues 
    315320   ! 
     321 
     322#else 
     323   SUBROUTINE Agrif_InitValues 
     324      !!------------------------------------------ 
     325      !!   *** ROUTINE Agrif_InitValues *** 
     326      !! 
     327      !! ** Purpose :: Declaration of variables to 
     328      !!               be interpolated 
     329      !!------------------------------------------ 
     330      USE Agrif_Util 
     331      USE oce  
     332      USE dom_oce 
     333      USE opa 
     334      USE trc 
     335      USE in_out_manager 
     336      USE agrif_top_update 
     337      USE agrif_top_interp 
     338      USE agrif_top_sponge 
     339 
     340      IMPLICIT NONE 
     341 
     342      REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 
     343      LOGICAL check_namelist 
     344 
     345      ! 0. Initializations 
     346      !------------------- 
     347#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4 
     348      jp_cfg = -1    ! set special value for jp_cfg on fine grids 
     349      cp_cfg = "default" 
     350#endif 
     351 
     352      Call opa_init  ! Initializations of each fine grid 
     353      Call agrif_opa_init 
     354 
     355      ! 1. Declaration of the type of variable which have to be interpolated 
     356      !--------------------------------------------------------------------- 
     357      Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/)) 
     358      Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/)) 
     359      Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/)) 
     360       
     361      ! 2. Space directions for each variables 
     362      !--------------------------------------- 
     363      Call Agrif_Set_raf(trn,(/'x','y','N','N'/)) 
     364      Call Agrif_Set_raf(trb,(/'x','y','N','N'/)) 
     365      Call Agrif_Set_raf(tra,(/'x','y','N','N'/)) 
     366 
     367      ! 3. Type of interpolation 
     368      !-------------------------  
     369      Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear) 
     370      Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear) 
     371 
     372      ! 4. Location of interpolation 
     373      !----------------------------- 
     374      Call Agrif_Set_bc(trn,(/0,1/)) 
     375      Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) 
     376 
     377      ! 5. Update type 
     378      !---------------  
     379      Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average) 
     380      Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average) 
     381 
     382      ! 6. First interpolations of potentially non zero fields 
     383      !------------------------------------------------------- 
     384      Agrif_SpecialValue=0. 
     385      Agrif_UseSpecialValue = .TRUE. 
     386      Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 
     387      Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 
     388      Agrif_UseSpecialValue = .FALSE. 
     389 
     390      ! 7. Some controls 
     391      !----------------- 
     392      check_namelist = .true. 
     393             
     394      IF( check_namelist ) THEN 
     395      
     396         ! Check time steps            
     397         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
     398            WRITE(*,*) 'incompatible time step between grids' 
     399            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
     400            WRITE(*,*) 'child  grid value : ',nint(rdt) 
     401            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
     402            STOP 
     403         ENDIF 
     404          
     405         ! Check run length 
     406         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     407            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     408            WRITE(*,*) 'incompatible run length between grids' 
     409            WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
     410               Agrif_Parent(nit000)+1),' time step' 
     411            WRITE(*,*) 'child  grid value : ', & 
     412               (nitend-nit000+1),' time step' 
     413            WRITE(*,*) 'value on child grid should be : ', & 
     414               Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     415               Agrif_Parent(nit000)+1) 
     416            STOP 
     417         ENDIF 
     418          
     419         ! Check coordinates 
     420         IF( ln_zps ) THEN 
     421            ! check parameters for partial steps  
     422            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     423               WRITE(*,*) 'incompatible e3zps_min between grids' 
     424               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     425               WRITE(*,*) 'child grid  :',e3zps_min 
     426               WRITE(*,*) 'those values should be identical' 
     427               STOP 
     428            ENDIF           
     429            IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
     430               WRITE(*,*) 'incompatible e3zps_rat between grids' 
     431               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
     432               WRITE(*,*) 'child grid  :',e3zps_rat 
     433               WRITE(*,*) 'those values should be identical'                   
     434               STOP 
     435            ENDIF 
     436         ENDIF 
     437        ! Check passive tracer cell 
     438        IF( ndttrc .ne. 1 ) THEN 
     439           WRITE(*,*) 'ndttrc should be equal to 1' 
     440        ENDIF 
     441 
     442      ENDIF 
     443 
     444      CALL Agrif_Update_trc(0) 
     445      nbcline_trc = 0 
     446 
     447   END SUBROUTINE Agrif_InitValues 
     448#endif 
    316449    
    317450SUBROUTINE Agrif_detect(g,sizex) 
Note: See TracChangeset for help on using the changeset viewer.