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 6101 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM – NEMO

Ignore:
Timestamp:
2015-12-17T16:48:41+01:00 (8 years ago)
Author:
cbricaud
Message:

correction of bugs from last update and improvments for CRS

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
Files:
4 added
24 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    r5602 r6101  
    152152      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivb_crs , hdivn_crs     
    153153      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshb_crs, sshn_crs , ssha_crs 
    154       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: rhop_crs,rhd_crs,rb2_crs 
     154      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: rhop_crs,rhd_crs,rn2_crs,rb2_crs 
    155155      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: gru_crs, grv_crs 
    156156      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: gtsu_crs, gtsv_crs 
     
    160160      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs 
    161161      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: fmmflx_crs 
    162       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs 
     162      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs, taum_crs 
    163163      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs 
    164164 
     
    179179      ! Vertical diffusion 
    180180      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp   
     181      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  en_crs            !: vert. diffusivity coef. [m2/s] at w-point for temp   
     182      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  avtb_2d_crs       !: vert. diffusivity coef. [m2/s] at w-point for temp   
    181183# if defined key_zdfddm 
    182184      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point 
     
    261263         &      hdivb_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , & 
    262264         &      rke_crs(jpi_crs,jpj_crs,jpk), rhop_crs(jpi_crs,jpj_crs,jpk)  , & 
    263          &      rb2_crs(jpi_crs,jpj_crs,jpk) ,rhd_crs(jpi_crs,jpj_crs,jpk)   , rab_crs_n(jpi_crs,jpj_crs,jpk,jpts) , & 
     265         &      rb2_crs(jpi_crs,jpj_crs,jpk) ,rn2_crs(jpi_crs,jpj_crs,jpk) , & 
     266         &      rhd_crs(jpi_crs,jpj_crs,jpk)   , rab_crs_n(jpi_crs,jpj_crs,jpk,jpts) , & 
     267         &      avtb_2d_crs(jpi_crs,jpj_crs), & 
    264268         &      gtsu_crs(jpi_crs,jpj_crs,jpts) ,gtsv_crs(jpi_crs,jpj_crs,jpts) , & 
    265269                gru_crs(jpi_crs,jpj_crs) ,grv_crs(jpi_crs,jpj_crs) , STAT=ierr(11)) 
     
    268272         &     emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 
    269273         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , & 
    270          &     vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), & 
     274         &     vtau_crs(jpi_crs,jpj_crs), taum_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), & 
    271275         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  ) 
    272276 
    273277#if defined key_traldf_c3d 
    274       ALLOCATE( ahtt_crs(jpi_crs,jpj_crs,jpk) , ahtu_crs(jpi_crs,jpj_crs,jpk) , ahtv_crs(jpi_crs,jpj_crs,jpk) , ahtw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(13) ) 
     278      ALLOCATE( ahtt_crs(jpi_crs,jpj_crs,jpk) , ahtu_crs(jpi_crs,jpj_crs,jpk) , & 
     279              & ahtv_crs(jpi_crs,jpj_crs,jpk) , ahtw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(13) ) 
    275280#elif defined key_traldf_c2d 
    276       ALLOCATE( ahtt_crs(jpi_crs,jpj_crs    ) , ahtu_crs(jpi_crs,jpj_crs    ) , ahtv_crs(jpi_crs,jpj_crs    ) , ahtw_crs(jpi_crs,jpj_crs    ) , STAT=ierr(13) ) 
     281      ALLOCATE( ahtt_crs(jpi_crs,jpj_crs    ) , ahtu_crs(jpi_crs,jpj_crs    ) , & 
     282              & ahtv_crs(jpi_crs,jpj_crs    ) , ahtw_crs(jpi_crs,jpj_crs    ) , STAT=ierr(13) ) 
    277283#elif defined key_traldf_c1d 
    278284      ALLOCATE( ahtt_crs(        jpk) , ahtu_crs(        jpk) , ahtv_crs(        jpk) , ahtw_crs(        jpk) , STAT=ierr(13) ) 
    279285#endif 
    280286 
    281      ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsb_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    & 
     287     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsb_crs(jpi_crs,jpj_crs,jpk,jpts),  & 
     288               en_crs(jpi_crs,jpj_crs,jpk),   avt_crs(jpi_crs,jpj_crs,jpk),    & 
    282289# if defined key_zdfddm 
    283290         &      avs_crs(jpi_crs,jpj_crs,jpk),    & 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r5602 r6101  
    3838   USE crslbclnk 
    3939   USE lib_mpp 
    40     
     40!cbr   USE ieee_arithmetic    
    4141 
    4242   IMPLICIT NONE 
     
    5757#  include "domzgr_substitute.h90" 
    5858    
    59    !! $Id$ 
    6059CONTAINS 
    6160 
     
    6766      INTEGER  ::  iji, ijj 
    6867      REAL(wp) ::  zmask 
     68      INTEGER  :: ir,jr 
    6969       
    7070      ! Initialize 
     
    130130               !write(narea+5000,*)"mask ",ijie,ijis,ijjs,ijje 
    131131               !ENDIF 
     132 
     133               ir=303-nimpp_crs+1 ; jr=302-njmpp_crs+1 
     134               IF( ji==ir .AND. jj==jr )THEN 
     135                   WRITE(narea+2000,*)"mask",ir,jr,ijis+nimpp-1,ijjs+njmpp-1 
     136               ENDIF 
    132137 
    133138               !IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200) 
     
    215220      INTEGER :: ji, jj, jk                   ! dummy loop indices 
    216221      INTEGER :: ijis, ijjs 
     222      INTEGER  :: ir,jr 
    217223 
    218224   
     
    225231                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    226232                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs) 
     233                  ir=303-nimpp_crs+1 ; jr=302-njmpp_crs+1 
     234                  WRITE(narea+2000,*)"coordT1",ir,jr 
     235                  IF( ji==ir .AND. jj==jr )THEN 
     236                     WRITE(narea+2000,*)"coordT",ir,jr,ijis+nimpp-1,ijjs+njmpp-1 
     237                  ENDIF 
    227238               ENDDO 
    228239            ENDDO 
     
    530541      !!  
    531542      !!  Arguments 
    532       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld   ! T, U, V or W on parent grid 
    533       CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN 
     543      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)        :: p_fld   ! T, U, V or W on parent grid 
     544      CHARACTER(len=*),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN 
    534545      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V  
    535546      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask 
     
    547558      INTEGER  :: ii, ij, ijie, ijje, je_2 
    548559      REAL(wp) :: zflcrs, zsfcrs    
    549       REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask   
     560      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask,ztabtmp 
    550561      INTEGER  :: iji, ijj 
     562      INTEGER  :: ir,jr 
     563      REAL(wp), DIMENSION(nn_factx,nn_facty):: ztmp 
     564      REAL(wp), DIMENSION(nn_factx*nn_facty):: ztmp1 
     565      REAL(wp), DIMENSION(:), ALLOCATABLE   :: ztmp2 
     566      INTEGER , DIMENSION(1)  :: zdim1 
     567      REAL(wp) :: zmin,zmax 
    551568      !!----------------------------------------------------------------   
    552569    
     
    554571 
    555572      SELECT CASE ( cd_op ) 
    556        
     573  
    557574         CASE ( 'VOL' ) 
    558575       
     
    633650                             &     + p_fld(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk) & 
    634651                             &     + p_fld(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk)  
    635  
    636652                           zsfcrs =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk) & 
    637653                             &     + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) & 
    638654                             &     + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)  
    639655                            ! 
     656!cbr                            IF( ieee_is_nan(p_fld_crs(ii,ij,jk))) THEN 
     657 
    640658                           p_fld_crs(ii,ij,jk) = zflcrs 
    641659                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 
     
    648666 
    649667              CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    650  
     668         CASE ( 'LOGVOL' ) 
     669 
     670            CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk, ztabtmp ) 
     671 
     672            zmin=MINVAL(p_fld) ; zmax=MAXVAL(p_fld);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"p_fld",zmin,zmax; CALL flush(numout) 
     673 
     674            ztabtmp(:,:,:)=0._wp 
     675            WHERE(p_fld* p_mask .NE. 0._wp ) ztabtmp =  LOG10(p_fld * p_mask)*p_mask 
     676            zmin=MINVAL(ztabtmp) ; zmax=MAXVAL(ztabtmp);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"LOG()",zmin,zmax; CALL flush(numout) 
     677            ztabtmp = ztabtmp * p_mask 
     678            zmin=MINVAL(ztabtmp) ; zmax=MAXVAL(ztabtmp);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"LOG()*tmask",zmin,zmax; CALL flush(numout) 
     679 
     680            SELECT CASE ( cd_type ) 
     681 
     682               CASE( 'T', 'W' ) 
     683                     DO jk = 1, jpk 
     684                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
     685                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk) 
     686                    ENDDO 
     687 
     688                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     689                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     690                        je_2 = mje_crs(2) 
     691                        DO jk = 1, jpk 
     692                           DO ji = nistr, niend, nn_factx 
     693                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     694                              zflcrs =  ztabtmp(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk)   & 
     695                                &     + ztabtmp(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk)   & 
     696                                &     + ztabtmp(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk) 
     697 
     698                              zsfcrs =  zsurf(ji,je_2,jk) + zsurf(ji+1,je_2,jk) + zsurf(ji+2,je_2,jk) 
     699                              ! 
     700                              p_fld_crs(ii,2,jk) = 0._wp 
     701                              IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
     702                              p_fld_crs(ii,2,jk) = 10 ** ( p_fld_crs(ii,2,jk) * p_mask_crs(ii,2,jk) ) * p_mask_crs(ii,2,jk) 
     703                           ENDDO 
     704                        ENDDO 
     705                     ENDIF 
     706                  ELSE 
     707                     je_2 = mjs_crs(2) 
     708                     DO jk = 1, jpk 
     709                        DO ji = nistr, niend, nn_factx 
     710                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     711                           zflcrs =  ztabtmp(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk) & 
     712                             &     + ztabtmp(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk) & 
     713                             &     + ztabtmp(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk) & 
     714                             &     + ztabtmp(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk) & 
     715                             &     + ztabtmp(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk) & 
     716                             &     + ztabtmp(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk) & 
     717                             &     + ztabtmp(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk) & 
     718                             &     + ztabtmp(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk) & 
     719                             &     + ztabtmp(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk) 
     720 
     721                           zsfcrs =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) & 
     722                             &     + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk) & 
     723                             &     + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk) 
     724                            ! 
     725                            p_fld_crs(ii,2,jk) = 0._wp 
     726                            IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
     727                            p_fld_crs(ii,2,jk) = 10 ** ( p_fld_crs(ii,2,jk) * p_mask_crs(ii,2,jk) ) * p_mask_crs(ii,2,jk) 
     728                        ENDDO 
     729                     ENDDO 
     730                  ENDIF 
     731                  ! 
     732                  DO jk = 1, jpk 
     733                     DO jj  = njstr, njend, nn_facty 
     734                        DO ji = nistr, niend, nn_factx 
     735                           ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     736                           ij = ( jj - njstr ) * rfacty_r + 3 
     737                           zflcrs =  ztabtmp(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) & 
     738                             &     + ztabtmp(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) & 
     739                             &     + ztabtmp(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) & 
     740                             &     + ztabtmp(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk) & 
     741                             &     + ztabtmp(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk) & 
     742                             &     + ztabtmp(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk) & 
     743                             &     + ztabtmp(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk) & 
     744                             &     + ztabtmp(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk) & 
     745                             &     + ztabtmp(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk) 
     746                           zsfcrs =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk) & 
     747                             &     + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) & 
     748                             &     + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 
     749                            ! 
     750                           p_fld_crs(ii,ij,jk) = 0._wp 
     751                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 
     752                           p_fld_crs(ii,ij,jk) = 10 ** ( p_fld_crs(ii,ij,jk) *  p_mask_crs(ii,ij,jk) ) * p_mask_crs(ii,ij,jk) 
     753                        ENDDO 
     754                     ENDDO 
     755                  ENDDO 
     756               CASE DEFAULT 
     757                    STOP 
     758               END SELECT 
     759 
     760 
     761              !WHERE( p_fld .NE. 0._wp ) p_fld=10**(p_fld) 
     762              !zmin=MINVAL(p_fld) ; zmax=MAXVAL(p_fld);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld)",zmin,zmax ; CALL flush(numout) 
     763              !p_fld = p_fld * p_mask 
     764              !zmin=MINVAL(p_fld) ; zmax=MAXVAL(p_fld);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld)*tmask",zmin,zmax ; CALL flush(numout) 
     765 
     766              zmin=MINVAL(p_fld_crs) ; zmax=MAXVAL(p_fld_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"p_fld_crs",zmin,zmax; CALL flush(numout) 
     767              !p_fld_crs=10**(p_fld_crs*p_mask_crs) 
     768              !zmin=MINVAL(p_fld_crs) ; zmax=MAXVAL(p_fld_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld_crs)",zmin,zmax; CALL flush(numout) 
     769              !p_fld_crs=p_fld_crs*p_mask_crs 
     770              !zmin=MINVAL(p_fld_crs) ; zmax=MAXVAL(p_fld_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"10**(p_fld_crs)*tmask",zmin,zmax; CALL flush(numout) 
     771 
     772              CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ,ztabtmp ) 
     773         CASE ( 'MED' ) 
     774 
     775            CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     776 
     777            SELECT CASE ( cd_type ) 
     778 
     779               CASE( 'T', 'W' ) 
     780                     DO jk = 1, jpk 
     781                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
     782                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk) 
     783                    ENDDO 
     784 
     785                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     786                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     787                        je_2 = mje_crs(2) 
     788                        DO jk = 1, jpk 
     789                           DO ji = nistr, niend, nn_factx 
     790                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     791 
     792                              ztmp1(:) = 0._wp 
     793                              ztmp1(1:3) =  p_fld(ji:ji+2,je_2,jk) 
     794                              CALL PIKSRT(nn_factx*nn_facty,ztmp1) 
     795                              ir=0 
     796                              jr=1 
     797                              DO WHILE( jr .LE. nn_factx*nn_facty ) 
     798                                 IF( ztmp1(jr) == 0. )THEN 
     799                                    ir=jr 
     800                                    jr=jr+1 
     801                                 ELSE 
     802                                    EXIT 
     803                                 ENDIF 
     804                              ENDDO 
     805                              IF( ir .LE. nn_factx*nn_facty-1 )THEN 
     806                                 ALLOCATE( ztmp2(nn_factx*nn_facty-ir) ) 
     807                                 ztmp2(1:nn_factx*nn_facty-ir) = ztmp1(1+ir:nn_factx*nn_facty) 
     808                                 jr=INT( 0.5 * REAL(nn_factx*nn_facty-ir,wp) )+1 
     809                                 p_fld_crs(ii,2,jk) = ztmp2(jr) 
     810                                 DEALLOCATE( ztmp2 ) 
     811                              ELSE 
     812                                 p_fld_crs(ii,ij,jk) = 0._wp 
     813                              ENDIF 
     814 
     815                           ENDDO 
     816                        ENDDO 
     817                     ENDIF 
     818                  ELSE 
     819                     je_2 = mjs_crs(2) 
     820                     DO jk = 1, jpk 
     821                        DO ji = nistr, niend, nn_factx 
     822                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
     823                            
     824                           ztmp(:,:)= p_fld(ji:ji+2,je_2:je_2+2,jk) 
     825                           zdim1(1)=nn_factx*nn_facty 
     826                           ztmp1(:) = RESHAPE( ztmp(:,:) , zdim1 ) 
     827                           CALL PIKSRT(nn_factx*nn_facty,ztmp1) 
     828                           ir=0 
     829                           jr=1 
     830                           DO WHILE( jr .LE. nn_factx*nn_facty ) 
     831                              IF( ztmp1(jr) == 0. ) THEN 
     832                                 ir=jr 
     833                                 jr=jr+1 
     834                              ELSE 
     835                                 EXIT 
     836                              ENDIF 
     837                           ENDDO 
     838                           IF( ir .LE. nn_factx*nn_facty-1 )THEN 
     839                              ALLOCATE( ztmp2(nn_factx*nn_facty-ir) ) 
     840                              ztmp2(1:nn_factx*nn_facty-ir) = ztmp1(1+ir:nn_factx*nn_facty) 
     841                              jr=INT( 0.5 * REAL(nn_factx*nn_facty-ir,wp) )+1 
     842                              p_fld_crs(ii,2,jk) = ztmp2(jr) 
     843                              DEALLOCATE( ztmp2 ) 
     844                           ELSE 
     845                           p_fld_crs(ii,ij,jk) = 0._wp 
     846                           ENDIF 
     847 
     848                        ENDDO 
     849                     ENDDO 
     850                  ENDIF 
     851                  ! 
     852                  DO jk = 1, jpk 
     853                     DO jj  = njstr, njend, nn_facty 
     854                        DO ji = nistr, niend, nn_factx 
     855                           ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     856                           ij = ( jj - njstr ) * rfacty_r + 3 
     857 
     858                           ztmp(:,:)= p_fld(ji:ji+2,jj:jj+2,jk)  
     859                           zdim1(1)=nn_factx*nn_facty 
     860                           ztmp1(:) = RESHAPE( ztmp(:,:) , zdim1 ) 
     861                           CALL PIKSRT(nn_factx*nn_facty,ztmp1) 
     862                           ir=0 
     863                           jr=1 
     864                           DO WHILE( jr .LE. nn_factx*nn_facty ) 
     865                              IF( ztmp1(jr) == 0. ) THEN 
     866                                 ir=jr 
     867                                 jr=jr+1 
     868                              ELSE 
     869                                 EXIT 
     870                              ENDIF 
     871                           ENDDO 
     872                           IF( ir .LE. nn_factx*nn_facty-1 )THEN 
     873                              ALLOCATE( ztmp2(nn_factx*nn_facty-ir) ) 
     874                              ztmp2(1:nn_factx*nn_facty-ir) = ztmp1(1+ir:nn_factx*nn_facty) 
     875                              jr=INT( 0.5 * REAL(nn_factx*nn_facty-ir,wp) )+1 
     876                              p_fld_crs(ii,ij,jk) = ztmp2(jr) 
     877                              DEALLOCATE( ztmp2 ) 
     878                           ELSE 
     879                              p_fld_crs(ii,ij,jk) = 0._wp 
     880                           ENDIF 
     881 
     882                        ENDDO 
     883                     ENDDO 
     884                  ENDDO 
     885               CASE DEFAULT 
     886                    STOP 
     887               END SELECT 
     888 
     889              CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     890  
    651891         CASE ( 'SUM' ) 
    652892          
     
    23902630      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 
    23912631 
    2392       CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf ) 
     2632      CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    23932633 
    23942634   END SUBROUTINE crs_dom_sfc 
     
    28933133      ENDDO 
    28943134      
     3135      CALL wrk_alloc( jpi_crs, jpj_crs, zmbk ) 
     3136 
    28953137      zmbk(:,:) = 0.0 
    28963138      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = INT( zmbk(:,:) ) 
     
    29213163   END SUBROUTINE crs_dom_bat 
    29223164 
     3165   SUBROUTINE PIKSRT(N,ARR) 
     3166     INTEGER                  ,INTENT(IN) :: N 
     3167     REAL(kind=8),DIMENSION(N),INTENT(INOUT) :: ARR 
     3168 
     3169     INTEGER      :: i,j 
     3170     REAL(kind=8) :: a 
     3171     !!---------------------------------------------------------------- 
     3172 
     3173     DO j=2, N 
     3174       a=ARR(j) 
     3175       DO i=j-1,1,-1 
     3176          IF(ARR(i)<=a) goto 10 
     3177          ARR(i+1)=ARR(i) 
     3178       ENDDO 
     3179       i=0 
     318010     ARR(i+1)=a 
     3181     ENDDO 
     3182     RETURN 
     3183 
     3184   END SUBROUTINE PIKSRT 
     3185 
    29233186 
    29243187END MODULE crsdom 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r5602 r6101  
    2727   USE iom 
    2828   USE zdfmxl_crs 
     29   USE eosbn2 
     30   USE zdfevd_crs 
     31   USE zdftke 
     32   USE zdftke_crs 
     33 
     34!   USE ieee_arithmetic 
    2935 
    3036   IMPLICIT NONE 
     
    4046   !!---------------------------------------------------------------------- 
    4147   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    42    !! $Id$ 
     48   !! $Id $ 
    4349   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4450   !!---------------------------------------------------------------------- 
     
    6571      !! 
    6672      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 
    67       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs  
     73      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs , ztmp 
    6874      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d,z2d_crs 
    69       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 
     75      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs, zerr_crs,zmax_crs 
     76      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp_crs 
     77      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: avte_crs 
    7078      REAL(wp)       :: z2dcrsu, z2dcrsv 
    71       REAL(wp)       :: zmin,zmax 
     79      REAL(wp)       :: zmin,zmax,icnt1,icnt2 
    7280      INTEGER :: i,j,ijis,ijie,ijjs,ijje 
    7381      REAL(wp)       :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z 
     82      REAL(wp)       :: zerr, zerr0, zerr1, zmean 
     83      INTEGER,DIMENSION(4,3) :: ind 
     84      REAL(wp),DIMENSION(4) :: zwgt 
    7485      INTEGER ::  iji,ijj 
     86      INTEGER :: jl,jm,jn 
    7587      !! 
    7688      !!---------------------------------------------------------------------- 
     
    8193      CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    8294      CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    83       CALL wrk_alloc( jpi, jpj, jpk, zt, zs         ) 
     95      CALL wrk_alloc( jpi, jpj, jpk, zt, zs , ztmp        ) 
    8496      CALL wrk_alloc( jpi, jpj,      z2d            ) 
    8597      ! 
    86       CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
     98      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) 
     99      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) 
     100      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) 
    87101      CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs     ) 
    88102 
     
    129143      CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) )    ! sst 
    130144 
    131        
     145      !n2 before 
     146      zt(:,:,:) = rn2b(:,:,:)  ;      zt_crs(:,:,:) = 0._wp 
     147      CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     148      rb2_crs(:,:,:) = zt_crs(:,:,:) 
     149      CALL iom_put("rb2_crs",rb2_crs) 
     150 
    132151      !  Salinity 
    133152      zs(:,:,:) = tsb(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp 
     
    252271         CASE ( 2 ) 
    253272            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
     273         CASE ( 3 ) 
     274            CALL crs_dom_ope( avt, 'LOGVOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 ) 
     275         CASE ( 4 ) 
     276            CALL crs_dom_ope( avt, 'MED', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
     277         CASE ( 5 ) 
     278            CALL crs_dom_ope( en , 'VOL', 'W', tmask, en_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
     279            CALL crs_dom_ope( taum , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     280            CALL crs_dom_ope( rn2(:,:,:), 'VOL', 'W', tmask, rn2_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     281            IF( kt==nit000 )CALL tke_avn_ini_crs 
     282            CALL tke_avn_crs 
     283            CALL zdf_evd_crs(kt) 
     284         CASE ( 6 ) 
     285 
     286            avte_crs(:,:,:,:) = 0._wp 
     287            ztmp(:,:,:)=1. 
     288 
     289            zt(:,:,:) = 0._wp 
     290            zs(:,:,:) = 0._wp 
     291            DO jk=2,jpk  
     292               WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) / fse3w(:,:,jk) 
     293               zt(:,:,jk)=  avt(:,:,jk) *  zs(:,:,jk) 
     294            ENDDO 
     295            CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
     296            CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
     297            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax  
     298            zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax  
     299            zt_crs=tmask_crs*zt_crs 
     300            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax  
     301            WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,1) = zt_crs / zs_crs 
     302            zmin=MINVAL(avte_crs(:,:,:,1));zmax=MAXVAL(avte_crs(:,:,:,1));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax  
     303 
     304            zt(:,:,:) = 0._wp 
     305            zs(:,:,:) = 0._wp 
     306            DO jk=2,jpk  
     307               WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) / fse3w(:,:,jk) 
     308               zt(:,:,jk)=  avt(:,:,jk) *  zs(:,:,jk) 
     309            ENDDO 
     310            CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
     311            CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
     312            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax  
     313            zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax  
     314            zt_crs=tmask_crs*zt_crs 
     315            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte1_crs",zmin,zmax 
     316            WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,2) = zt_crs / zs_crs 
     317            zmin=MINVAL(avte_crs(:,:,:,2));zmax=MAXVAL(avte_crs(:,:,:,2));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte2_crs",zmin,zmax 
     318 
     319            zt(:,:,:) = 0._wp 
     320            zs(:,:,:) = 0._wp 
     321            DO jk=2,jpk 
     322                WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) +  & 
     323                                                                  &   rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk)  
     324                zt(:,:,jk)=  avt(:,:,jk) *  zs(:,:,jk)                                                            
     325            ENDDO 
     326            CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
     327            CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
     328            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax  
     329            zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax  
     330            zt_crs=tmask_crs*zt_crs 
     331            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax 
     332            WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,3) = zt_crs / zs_crs 
     333            zmin=MINVAL(avte_crs(:,:,:,3));zmax=MAXVAL(avte_crs(:,:,:,3));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte3_crs",zmin,zmax 
     334 
     335            zt(:,:,:) = 0._wp 
     336            zs(:,:,:) = 0._wp 
     337            DO jk=2,jpk 
     338                WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) -  & 
     339                                                                  &   rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk)  
     340                zt(:,:,jk)=  avt(:,:,jk) *  zs(:,:,jk) 
     341            ENDDO 
     342            CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
     343            CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
     344            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax  
     345            zmin=MINVAL(zs_crs);zmax=MAXVAL(zs_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax  
     346            zt_crs=tmask_crs*zt_crs 
     347            zmin=MINVAL(zt_crs);zmax=MAXVAL(zt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax 
     348            WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,4) = zt_crs / zs_crs 
     349            zmin=MINVAL(avte_crs(:,:,:,4));zmax=MAXVAL(avte_crs(:,:,:,4));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avte4_crs",zmin,zmax 
     350 
     351            CALL iom_put( "avte_crs1", avte_crs(:,:,:,1) )   !  Kz 
     352            CALL iom_put( "avte_crs2", avte_crs(:,:,:,2) )   !  Kz 
     353            CALL iom_put( "avte_crs3", avte_crs(:,:,:,3) )   !  Kz 
     354            CALL iom_put( "avte_crs4", avte_crs(:,:,:,4) )   !  Kz 
     355!---------------------  
     356            CALL crs_dom_ope( avt, 'MED', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 ) 
     357!?            zmin=MINVAL(zs_crs*tmask_crs);zmax=MAXVAL(zs_crs*tmask_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"logvol zs_crs*tmask ",zmin,zmax ; call flush(numout) 
     358            CALL iom_put( "zs_crs", zs_crs )   !  Kzlogvol 
     359!--------------------- ok 
     360 
     361            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, zmax_crs, p_e12=e1e2t, p_e3=zfse3w,  psgn=1.0 ) 
     362            WRITE(narea+200,*)"zmax_crs ",SHAPE(zmax_crs) ; call flush(narea+200) 
     363            CALL iom_put( "zmax_crs", zmax_crs )   !  Kzlogvol 
     364            zmin=MINVAL(zmax_crs*tmask_crs);zmax=MAXVAL(zmax_crs*tmask_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"vol zmax_crs*tmask ",zmin,zmax ; call flush(numout) 
     365!-------------------------nok 
     366            avt_crs=zs_crs 
     367 
     368 
     369            zerr0=0.01 
     370 
     371            icnt1=0 
     372            icnt2=0 
     373 
     374            zt_crs(:,:,:)=0._wp 
     375            zerr_crs(:,:,:)=0._wp 
     376            DO ji=1,jpi_crs  
     377            DO jj=1,jpj_crs  
     378            DO jk=1,jpk 
     379 
     380  
     381!-------------- 
     382               zwgt(1:4)=0._wp 
     383               DO jm=1,4 ; IF( avte_crs(ji,jj,jk,jm)  .GE. 0._wp .AND.  avte_crs(ji,jj,jk,jm)  .LE. zmax_crs(ji,jj,jk)  ) zwgt(jm) = 1._wp ; ENDDO 
     384!-------------- 
     385               IF( SUM(zwgt(1:4)) .NE. 0._wp ) THEN   
     386                  zmean = SUM( zwgt(1:4)*avte_crs(ji,jj,jk,1:4)) / SUM(zwgt(1:4) ) 
     387                  zerr  = SQRT(SUM( zwgt(1:4)*(avte_crs(ji,jj,jk,1:4)-zmean)*(avte_crs(ji,jj,jk,1:4)-zmean) ) / SUM(zwgt(1:4) ) ) 
     388               ELSE 
     389                  zmean=0._wp 
     390                 zerr=1.e10 
     391               ENDIF 
     392!-------------- 
     393 
     394               zerr_crs(ji,jj,jk)=zerr 
     395 
     396               IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )zt_crs(ji,jj,jk)=zmean 
     397               IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )avt_crs(ji,jj,jk)=zmean 
     398 
     399               IF( tmask_crs(ji,jj,jk) == 1 ) icnt1=icnt1+1 
     400               IF( tmask_crs(ji,jj,jk) == 1 .AND.  zerr .LE. zerr0 .AND. zmean .GT. 0._wp ) icnt2=icnt2+1 
     401 
     402               !IF( ieee_is_nan(  zt_crs(ji,jj,jk))   )WRITE(narea+200,*)"NANMEANEFF ",ji,jj,jk,tmask_crs(ji,jj,jk)  ; call flush(narea+200) 
     403               !IF( ieee_is_nan(  zs_crs(ji,jj,jk))   )WRITE(narea+200,*)"NANLOG ",ji,jj,jk,tmask_crs(ji,jj,jk)  ; call flush(narea+200) 
     404               !IF( ieee_is_nan( avt_crs(ji,jj,jk))   )WRITE(narea+200,*)"NANAVT ",ji,jj,jk,tmask_crs(ji,jj,jk)  ; call flush(narea+200) 
     405            ENDDO 
     406            ENDDO 
     407            ENDDO 
     408            zmin=MINVAL(avt_crs);zmax=MAXVAL(avt_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avt_crs ",zmin,zmax  ; call flush(numout) 
     409            zmin=MINVAL(avt_crs*tmask_crs);zmax=MAXVAL(avt_crs*tmask_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"avt_crs*tmask ",zmin,zmax  ; call flush(numout) 
     410 
     411            CALL mpp_sum(icnt1) 
     412            CALL mpp_sum(icnt2) 
     413            IF(lwp)WRITE(numout,*)"TOTO",kt,icnt1,icnt2 
     414            CALL iom_put( "zt_crs", zt_crs )   !  Kz 
     415            CALL iom_put( "zerr_crs", zerr_crs )   !  Kz 
     416 
    254417      END SELECT 
    255418      ! 
     
    293456      CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) 
    294457      CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v ) 
    295       CALL wrk_dealloc( jpi, jpj, jpk, zt, zs         ) 
     458      CALL wrk_dealloc( jpi, jpj, jpk, zt, zs, ztmp   ) 
    296459      CALL wrk_dealloc( jpi, jpj, z2d                 ) 
    297       CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
     460      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) 
     461      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) 
     462      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) 
    298463      CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs     ) 
    299464      ! 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r5602 r6101  
    256256     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=zfse3w, psgn=1.0 ) 
    257257 
    258  
    259258     !--------------------------------------------------------- 
    260259     ! 4.  Coarse grid ocean volume and averaging weights 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5602 r6101  
    2222                       gphiv, gphif, & 
    2323                       agrif_root, agrif_cfixed, lk_agrif, & 
    24                        rdt,rdttra, gdept_0, ln_crs, gdepw_0,  adatrj, fjulday 
     24                       rdt,rdttra, gdept_0, ln_crs, gdepw_0,  adatrj, fjulday, & 
     25                       mikt 
    2526 
    2627   USE c1d             ! 1D vertical configuration 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_crs.F90

    r5601 r6101  
    493493         ! 
    494494      ELSE                             ! Madec operator : slopes at u-, v-, and w-points 
    495          ALLOCATE( uslp_crs(jpi_crs,jpj_crs,jpk) , vslp_crs(jpi_crs,jpj_crs,jpk) , wslpi_crs(jpi_crs,jpj_crs,jpk) , wslpj_crs(jpi_crs,jpj_crs,jpk) ,  & 
    496             &   omlmask(jpi_crs,jpj_crs,jpk) , uslpml(jpi_crs,jpj_crs)   , vslpml(jpi_crs,jpj_crs)    , wslpiml(jpi_crs,jpj_crs)   , wslpjml(jpi_crs,jpj_crs) , STAT=ierr ) 
     495         ALLOCATE( uslp_crs(jpi_crs,jpj_crs,jpk) , vslp_crs(jpi_crs,jpj_crs,jpk) , &  
     496                 & wslpi_crs(jpi_crs,jpj_crs,jpk) , wslpj_crs(jpi_crs,jpj_crs,jpk) ,  & 
     497                 & omlmask(jpi_crs,jpj_crs,jpk) ,  & 
     498                 & uslpml(jpi_crs,jpj_crs)   ,  vslpml(jpi_crs,jpj_crs)  , &  
     499                 & wslpiml(jpi_crs,jpj_crs)   , wslpjml(jpi_crs,jpj_crs) , STAT=ierr ) 
    497500         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 
    498501 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r5602 r6101  
    8080   !                                   !!!  simplified eos coefficients 
    8181   ! default value: Vallis 2006 
    82    REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff.  
    83    REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff.  
     82   REAL(wp), PUBLIC ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff.  
     83   REAL(wp), PUBLIC ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff.  
    8484   REAL(wp) ::   rn_lambda1 = 5.9520e-2_wp     ! cabbeling coeff. in T^2         
    8585   REAL(wp) ::   rn_lambda2 = 5.4914e-4_wp     ! cabbeling coeff. in S^2         
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90

    r5601 r6101  
    178178         END IF 
    179179         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    180          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    181            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    182            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     180         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     181           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     182           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    183183         ENDIF 
    184184 
     
    240240         END IF 
    241241         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    242          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    243            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:) 
    244            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:) 
     242         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     243           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
     244           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
    245245         ENDIF 
    246246         ! 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90

    r5601 r6101  
    219219         ! 
    220220         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    221          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    222             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    223             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     221         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
     222            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) ) 
     223            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    224224         ENDIF 
    225225  
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_crs.F90

    r5105 r6101  
    150150         ! 
    151151         ! "Poleward" diffusive heat or salt transports 
    152          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    153             IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    154             IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     152         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
     153            IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
     154            IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    155155         ENDIF 
    156156         !                                                  ! ================== 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r5601 r6101  
    134134         END DO 
    135135      END DO 
     136      CALL iom_put("hmlpt",hmlpt) 
     137 
    136138      IF( .NOT.lk_offline ) THEN            ! no need to output in offline mode 
    137139         CALL iom_put( "mldr10_1", hmlp )   ! mixed layer depth 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl_crs.F90

    r5601 r6101  
    6464      REAL(wp) ::   zN2_c        ! local scalar 
    6565      INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace 
     66      REAL(wp), POINTER, DIMENSION(:,:) ::  z2d   ! 2D workspace 
    6667      !!---------------------------------------------------------------------- 
    6768      ! 
     
    6970      ! 
    7071      CALL wrk_alloc( jpi_crs,jpj_crs, imld ) 
     72      CALL wrk_alloc( jpi_crs,jpj_crs, z2d ) 
    7173 
    7274      IF( kt == nit000 ) THEN 
     
    98100      END DO 
    99101      ! 
     102      z2d=REAL(nmln_crs,wp) 
     103      CALL iom_put("nmln_crs",z2d) 
     104      CALL iom_put("hmlpt_crs",hmlpt_crs) 
     105      ! 
    100106      CALL wrk_dealloc( jpi_crs,jpj_crs, imld ) 
     107      CALL wrk_dealloc( jpi_crs,jpj_crs, z2d ) 
    101108      ! 
    102109      IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl_crs') 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r5602 r6101  
    6464 
    6565   !                      !!** Namelist  namzdf_tke  ** 
    66    LOGICAL  ::   ln_mxl0   ! mixing length scale surface value as function of wind stress or not 
    67    INTEGER  ::   nn_mxl    ! type of mixing length (=0/1/2/3) 
    68    REAL(wp) ::   rn_mxl0   ! surface  min value of mixing length (kappa*z_o=0.4*0.1 m)  [m] 
    69    INTEGER  ::   nn_pdl    ! Prandtl number or not (ratio avt/avm) (=0/1) 
    70    REAL(wp) ::   rn_ediff  ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) 
     66   LOGICAL  , PUBLIC  ::   ln_mxl0   ! mixing length scale surface value as function of wind stress or not 
     67   INTEGER  , PUBLIC  ::   nn_mxl    ! type of mixing length (=0/1/2/3) 
     68   REAL(wp) , PUBLIC  ::   rn_mxl0   ! surface  min value of mixing length (kappa*z_o=0.4*0.1 m)  [m] 
     69   INTEGER  , PUBLIC  ::   nn_pdl    ! Prandtl number or not (ratio avt/avm) (=0/1) 
     70   REAL(wp) , PUBLIC  ::   rn_ediff  ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) 
    7171   REAL(wp) ::   rn_ediss  ! coefficient of the Kolmogoroff dissipation  
    7272   REAL(wp) ::   rn_ebb    ! coefficient of the surface input of tke 
    7373   REAL(wp) ::   rn_emin   ! minimum value of tke           [m2/s2] 
    7474   REAL(wp) ::   rn_emin0  ! surface minimum value of tke   [m2/s2] 
    75    REAL(wp) ::   rn_bshear ! background shear (>0) currently a numerical threshold (do not change it) 
     75   REAL(wp) , PUBLIC  ::   rn_bshear ! background shear (>0) currently a numerical threshold (do not change it) 
    7676   INTEGER  ::   nn_etau   ! type of depth penetration of surface tke (=0/1/2/3) 
    7777   INTEGER  ::   nn_htau   ! type of tke profile of penetration (=0/1) 
     
    8181 
    8282   REAL(wp) ::   ri_cri    ! critic Richardson number (deduced from rn_ediff and rn_ediss values) 
    83    REAL(wp) ::   rmxl_min  ! minimum mixing length value (deduced from rn_ediff and rn_emin values)  [m] 
     83   REAL(wp) , PUBLIC  ::   rmxl_min  ! minimum mixing length value (deduced from rn_ediff and rn_emin values)  [m] 
    8484   REAL(wp) ::   rhftau_add = 1.e-3_wp     ! add offset   applied to HF part of taum  (nn_etau=3) 
    8585   REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5602 r6101  
    3333   USE step_oce         ! time stepping definition modules 
    3434   USE iom 
    35    USE crs 
     35   use wrk_nemo 
    3636 
    3737   IMPLICIT NONE 
     
    7676      INTEGER ::   indic    ! error indicator if < 0 
    7777      INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt) 
     78      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zrhop,zrhd 
     79 
    7880      !! --------------------------------------------------------------------- 
    7981 
     
    117119      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    118120      !  THERMODYNAMICS 
    119                          !cbr not used CALL eos_rab( tsb, rab_b )       ! before local thermal/haline expension ratio at T-points 
    120                          !cbr not used CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points 
     121                         CALL eos_rab( tsb, rab_b )       ! before local thermal/haline expension ratio at T-points 
     122                         CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points 
    121123                         CALL bn2    ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 
    122124                         CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency 
     
    169171                         CALL iom_put("rhd",rhd) 
    170172                         CALL iom_put("rn2b",rn2b) 
     173                         CALL iom_put("rn2",rn2) 
    171174                         CALL ldf_slp( kstp, rhd, rn2b )     ! before slope for Madec operator 
    172175         ENDIF 
     
    240243      IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
    241244 
     245      CALL wrk_alloc( jpi, jpj, jpk, zrhop, zrhd ) 
     246      CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) )                 ! now in situ and potential density 
     247      zrhop(:,:,jpk) = 0._wp 
     248      CALL iom_put( 'rhop', zrhop ) 
     249 
     250      CALL wrk_dealloc( jpi, jpj, jpk, zrhop, zrhd ) 
     251 
    242252#if defined key_top 
    243253      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    247257                         CALL dom_grid_crs 
    248258 
    249                          CALL eos_rab_crs( tsn_crs, rab_crs_n )       ! now    local thermal/haline expension ratio at T-points 
    250                          CALL bn2_crs    ( tsn_crs, rab_crs_n, rb2_crs  ) ! now    Brunt-Vaisala frequency 
     259                         !CALL eos_rab_crs( tsn_crs, rab_crs_n )       ! now    local thermal/haline expension ratio at T-points 
     260                         !CALL bn2_crs    ( tsn_crs, rab_crs_n, rb2_crs  ) ! now    Brunt-Vaisala frequency 
    251261                         CALL eos_crs ( tsn_crs, rhd_crs, rhop_crs, gdept_crs(:,:,:) ) ! now in situ density for hpg computation 
     262                         CALL iom_put("rhop_crs",rhop_crs) 
     263                         CALL iom_put("rhd_crs",rhd_crs) 
    252264 
    253265         IF( ln_zps )    CALL zps_hde_crs( kstp, jpts, tsb_crs, gtsu_crs, gtsv_crs, rhd_crs, gru_crs, grv_crs ) 
     
    265277 
    266278      IF( ln_crs_top )   CALL dom_grid_glo 
     279 
    267280#endif 
    268281 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r3294 r6101  
    136136            WRITE(numout,*) '          output of last fields in numwso' 
    137137         ENDIF 
    138          kindic = -3 
     138         WHERE( tsn(:,:,:,jp_sal) .LE. 0. )  tsn(:,:,:,jp_sal) = 0.1 
    139139      ENDIF 
    1401409500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5602 r6101  
    2424   USE trdtra 
    2525   USE trd_oce 
    26    USE iom 
     26   USE iom , ONLY : iom_open, iom_get, iom_close, jpdom_autoglo 
    2727 
    2828   IMPLICIT NONE 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_crs.F90

    r5601 r6101  
    219219         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options' 
    220220         nldf = -1 
    221       ENDIF 
    222  
    223       IF( .NOT. ln_trcldf_diff ) THEN 
    224          IF(lwp) WRITE(numout,*) '          No lateral diffusion on passive tracers' 
    225          nldf = -2 
    226221      ENDIF 
    227222 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r5602 r6101  
    1919   USE trc             ! ocean  passive tracers variables 
    2020   USE prtctl_trc      ! Print control for debbuging 
    21    USE iom 
     21   USE iom, ONLY : iom_varid, iom_get, iom_rstput,jpdom_autoglo 
    2222   USE trd_oce 
    2323   USE trdtra 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r5602 r6101  
    3434   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
    3535   USE zpshde_crs      ! partial step: hor. derivative       (zps_hde routine) 
    36    USE dom_oce , ONLY : ln_crs 
     36   USE dom_oce , ONLY : ln_crs, ln_isfcav 
    3737   USE crs     , ONLY : jpi_crs,jpj_crs,wn_crs,ln_crs_top !cbr 
    3838   USE ldfslp_crs 
    39  
    4039#if defined key_agrif 
    4140   USE agrif_top_sponge ! tracers sponges 
     
    111110               CALL zps_hde_crs( kstp, jptra, trn, gtru, gtrv ) 
    112111            ELSE 
    113                IF( ln_isfcav)        & 
     112               IF( ln_isfcav )THEN 
    114113                  CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! Partial steps: now horizontal gradient of passive 
    115114               ELSE 
    116115                  CALL zps_hde    ( kstp, jptra, trn, gtru, gtrv )   ! Partial steps: now horizontal gradient of passive 
    117116               ENDIF 
     117            ENDIF 
    118118         ENDIF 
    119119                                                                ! tracers at the bottom ocean level 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r5602 r6101  
    7676   USE dom_oce , ONLY : ln_sco => ln_sco 
    7777   USE dom_oce , ONLY : neuler => neuler 
     78   USE dom_oce , ONLY : mikt      => mikt          !: f-points (m) 
    7879 
    7980   USE crs,  ONLY : mi0 => mi0  
     
    282283   USE dom_oce , ONLY :   mbku      => mbku          !: f-points (m) 
    283284   USE dom_oce , ONLY :   mbkv      => mbkv          !: f-points (m) 
     285   USE dom_oce , ONLY :   mikt      => mikt          !: f-points (m) 
    284286 
    285287   !* IO manager * 
     
    401403#endif 
    402404 
     405 
     406   USE dom_oce , ONLY : ndastp 
     407   USE sbc_oce , ONLY : nn_ice_embd 
     408   USE sbc_oce , ONLY : ln_cpl 
     409   USE sbc_oce , ONLY : ncpl_qsr_freq 
     410 
    403411#else 
    404412   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r5602 r6101  
    1919   USE oce_trc       !  shared variables between ocean and passive tracers 
    2020   USE trc           !  passive tracers common variables 
     21!   USE iom           !  I/O manager 
    2122   USE lib_mpp       !  MPP library 
    2223   USE fldread       !  read input fields 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r5602 r6101  
    2525   USE trcini_my_trc   ! MY_TRC   initialisation 
    2626   USE trcdta          ! initialisation from files 
    27    USE zpshde,ONLY: zps_hde    ! partial step: hor. derivative   (zps_hde routine) 
     27   USE zpshde,ONLY: zps_hde, zps_hde_isf    ! partial step: hor. derivative   (zps_hde routine) 
    2828   USE zpshde_crs      ! partial step: hor. derivative   (zps_hde routine) 
    2929   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    3030   USE trcsub          ! variables to substep passive tracers 
    3131   USE lib_mpp         ! distribued memory computing library 
    32    USE sbc_oce, ONLY : ltrcdm2dc 
    3332   USE crs    , ONLY : ln_crs 
    34    USE dom_oce, ONLY : nn_cla 
     33   USE dom_oce, ONLY : nn_cla, ln_isfcav 
    3534   USE trcice          ! tracers in sea ice 
     35   USE sbc_oce 
    3636  
    3737   IMPLICIT NONE 
     
    148148  
    149149      tra(:,:,:,:) = 0._wp 
    150       IF( ln_zps .AND. .NOT. lk_c1d )THEN              ! Partial steps: before horizontal gradient of passive 
    151          IF( ln_crs )  THEN 
    152             CALL zps_hde_crs( nit000, jptra, trn, gtru, gtrv ) 
    153          ELSE 
    154             IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav )   &              ! Partial steps: before horizontal gradient of passive 
    155             &    CALL zps_hde    ( nit000, jptra, trn, gtru, gtrv  )  ! Partial steps: before horizontal gradient 
    156             IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   & 
    157             &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level 
    158          ENDIF 
     150      IF( ln_crs )  THEN 
     151         CALL zps_hde_crs( nit000, jptra, trn, gtru, gtrv ) 
     152      ELSE 
     153         IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav )   &              ! Partial steps: before horizontal gradient of passive 
     154         &    CALL zps_hde    ( nit000, jptra, trn, gtru, gtrv  )  ! Partial steps: before horizontal gradient 
     155         IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   & 
     156         &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level 
    159157      ENDIF 
    160158 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r5602 r6101  
    1111   !!---------------------------------------------------------------------- 
    1212   USE oce_trc          ! ocean dynamics and active tracers variables 
    13    USE sbc_oce , ONLY : ltrcdm2dc,qsr_mean 
    1413   USE trc 
    1514   USE trctrp           ! passive tracers transport 
     
    2423   USE in_out_manager 
    2524   USE trcsub 
    26    USE dom_oce, ONLY : nday, nmonth, nyear 
     25   USE dom_oce, ONLY : nday, nmonth, nyear, nsec1jan000, nsec_year 
     26   !USE sbc_oce 
    2727 
    2828   IMPLICIT NONE 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r3750 r6101  
    1515   USE oce_trc     ! shared variables between ocean and passive tracers 
    1616   USE trc         ! passive tracers common variables  
    17    USE iom         ! I/O manager 
     17!   USE iom         ! I/O manager 
    1818   USE dianam      ! Output file name 
    1919   USE trcwri_pisces 
Note: See TracChangeset for help on using the changeset viewer.