New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5105 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90 – NEMO

Ignore:
Timestamp:
2015-02-24T15:46:25+01:00 (9 years ago)
Author:
cbricaud
Message:

bug correction

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r4990 r5105  
    1717   USE trcnam_trp      ! passive tracers transport namelist variables 
    1818   USE trabbl          ! bottom boundary layer               (trc_bbl routine) 
     19   USE trabbl_crs      ! bottom boundary layer               (trc_bbl routine) 
    1920   USE trcbbl          ! bottom boundary layer               (trc_bbl routine) 
     21   USE trcbbl_crs      ! bottom boundary layer               (trc_bbl routine) 
    2022   USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine) 
    2123   USE trcdmp          ! internal damping                    (trc_dmp routine) 
    2224   USE trcldf          ! lateral mixing                      (trc_ldf routine) 
     25   USE trcldf_crs      ! lateral mixing                      (trc_ldf routine) 
    2326   USE trcadv          ! advection                           (trc_adv routine) 
     27   USE trcadv_crs      ! advection                           (trc_adv routine) 
    2428   USE trczdf          ! vertical diffusion                  (trc_zdf routine) 
     29   USE trczdf_crs      ! vertical diffusion                  (trc_zdf routine 
    2530   USE trcnxt          ! time-stepping                       (trc_nxt routine) 
    2631   USE trcrad          ! positivity                          (trc_rad routine) 
    2732   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
     33   USE trcsbc_crs      ! surface boundary condition          (trc_sbc routine) 
    2834   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
     35   USE zpshde_crs      ! partial step: hor. derivative       (zps_hde routine) 
     36   USE dom_oce , ONLY : ln_crs 
     37   USe crs, ONLY : jpi_crs,jpj_crs,wn_crs !cbr 
    2938 
    3039#if defined key_agrif 
     
    5867      !!---------------------------------------------------------------------- 
    5968      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index 
     69      REAL(wp) :: zmin,zmax 
     70      INTEGER :: ji,jj,jk 
    6071      !! --------------------------------------------------------------------- 
    6172      ! 
     
    6475      IF( .NOT. lk_c1d ) THEN 
    6576         ! 
    66                                 CALL trc_sbc( kstp )            ! surface boundary condition 
    67          IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
     77!         CALL test(kstp,1) 
     78!         IF( ln_crs ) THEN ;    CALL trc_sbc_crs( kstp ) 
     79!         ELSE              ;    CALL trc_sbc( kstp ) 
     80!         ENDIF 
     81!         CALL test(kstp,2) 
     82         IF( ln_crs ) THEN ;    CALL trc_bbl_crs( kstp ) 
     83         ELSE              ;    CALL trc_bbl( kstp ) 
     84         ENDIF 
    6885         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
     86!         CALL test(kstp,3) 
     87 
     88         IF( ln_crs ) THEN ;    CALL trc_adv_crs( kstp ) 
     89         ELSE              ;    CALL trc_adv( kstp ) 
     90         ENDIF 
     91!         CALL test(kstp,4) 
     92 
    6993         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
    70                                 CALL trc_adv( kstp )            ! horizontal & vertical advection  
    71                                 CALL trc_ldf( kstp )            ! lateral mixing 
     94         IF( ln_crs ) THEN ;    CALL trc_ldf_crs( kstp ) 
     95         ELSE              ;    CALL trc_ldf( kstp ) 
     96         ENDIF 
     97!         CALL test(kstp,5) 
    7298         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    7399            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
     
    75101         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge 
    76102#endif 
    77                                 CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
     103         IF( ln_crs ) THEN ;    CALL trc_zdf_crs( kstp ) 
     104         ELSE              ;    CALL trc_zdf( kstp ) 
     105         ENDIF 
     106!         CALL test(kstp,6) 
    78107                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
     108!         CALL test(kstp,7) 
    79109         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
    80110 
     
    82112      IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only 
    83113#endif 
    84          IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )  ! Partial steps: now horizontal gradient of passive 
     114         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive 
     115         IF( ln_zps    )THEN 
     116         IF( ln_crs ) THEN ;    CALL zps_hde_crs( kstp, jptra, trn, gtru, gtrv ) 
     117         ELSE              ;    CALL zps_hde( kstp, jptra, trn, gtru, gtrv ) 
     118         ENDIF 
     119         ENDIF 
    85120                                                                ! tracers at the bottom ocean level 
    86121         ! 
     
    98133      ! 
    99134   END SUBROUTINE trc_trp 
     135   SUBROUTINE test(kt,i) 
     136   INTEGER,INTENT(IN) :: kt,i 
     137   REAL(wp)::zmin,zmax 
     138   INTEGER :: ji,jj,jk 
     139   zmin=MINVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 
     140   zmax=MAXVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 
     141   IF(lwp)WRITE(numout,*)"trctrp b ",kt,i,zmin,zmax    
     142   zmin=MINVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 
     143   zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 
     144   IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax    
     145   zmin=MINVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 
     146   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 
     147   IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax    
     148   zmin=MINVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin) 
     149   zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax) 
     150   IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax    
     151   zmin=MINVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin) 
     152   zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax) 
     153   IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax    
    100154 
     155   IF(narea==267)WRITE(narea+5000,*)"tra(17,5,74,1) = ",kt,i,tra(17,5,74,1) 
     156 
     157   DO ji=1,jpi 
     158   DO jj=1,jpj 
     159   DO jk=1,jpk 
     160      IF( tra(ji,jj,jk,1) .NE.  tra(ji,jj,jk,1) )WRITE(narea+200,*)"BUG7 ",ji,jj,jk, tra(ji,jj,jk,1); CALL FLUSH(narea+200) 
     161   ENDDO 
     162   ENDDO 
     163   ENDDO 
     164    
     165   END SUBROUTINE test 
    101166#else 
    102167   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.