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

Ignore:
Timestamp:
2016-07-04T17:49:36+02:00 (8 years ago)
Author:
cbricaud
Message:

coarsening: continue cleaning of branch

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r6772 r6786  
    7575      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs , ztmp 
    7676      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d,z2d_crs 
    77       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs, zerr_crs,zmax_crs 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp_crs 
    79       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: avte_crs 
    80       REAL(wp)       :: z2dcrsu, z2dcrsv 
    81       REAL(wp)       :: z1_2dt 
    82       REAL(wp)       :: icnt1,icnt2 
     77      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs 
     78      REAL(wp):: z2dcrsu, z2dcrsv 
     79      REAL(wp):: z1_2dt 
    8380      INTEGER :: i,j,ijis,ijie,ijjs,ijje 
    84       REAL(wp)       :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z 
    85       REAL(wp)       :: zerr, zerr0, zerr1, zmean 
    86       INTEGER,DIMENSION(4,3) :: ind 
    87       REAL(wp),DIMENSION(4) :: zwgt 
    8881      INTEGER ::  iji,ijj 
    8982      INTEGER :: jl,jm,jn 
    90       REAL(wp)       :: zmin,zmax,zsuma0,zsuma1,zsuma2,zsuma3,zsumb0,zsumb1,zsumb2,zsumb3,zsumb4 
    9183      !! 
    9284      !!---------------------------------------------------------------------- 
    … …  
    10092      CALL wrk_alloc( jpi, jpj,      z2d            ) 
    10193      ! 
    102       CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) 
    103       CALL wrk_alloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) 
    104       CALL wrk_alloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) 
     94      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
    10595      CALL wrk_alloc( jpi_crs, jpj_crs, z2d_crs     ) 
    10696 
    … …  
    165155      CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u ) 
    166156      CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v ) 
     157      CALL iom_put("e2e3u_crs",e2e3u_crs) 
     158      CALL iom_put("e2e3u_msk",e2e3u_msk) 
     159      CALL iom_put("e1e3v_crs",e1e3v_crs) 
     160      CALL iom_put("e1e3v_msk",e1e3v_msk) 
    167161      !                                                                                  
    168162      CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=zs_crs, p_e3_max_crs=e3t_max_0_crs) 
    … …  
    262256         CASE ( 5 ) 
    263257#if defined key_zdftke 
    264             CALL crs_dom_ope( en , 'VOL', 'W', tmask, en_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
    265             CALL crs_dom_ope( taum , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    266             CALL crs_dom_ope( rn2(:,:,:), 'VOL', 'W', tmask, rn2_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
     258            CALL crs_dom_ope( en        , 'VOL', 'W', tmask, en_crs   , p_e12=e1e2t, p_e3=zfse3w         , psgn=1.0 ) 
     259            CALL crs_dom_ope( taum      , 'SUM', 'T', tmask, taum_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     260            CALL crs_dom_ope( rn2(:,:,:), 'VOL', 'W', tmask, rn2_crs  , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 ) 
    267261            IF( kt==nit000 )CALL tke_avn_ini_crs 
    268262            CALL tke_avn_crs 
    269263            CALL zdf_evd_crs(kt) 
    270264#endif 
    271          CASE ( 6 ) 
    272  
    273             avte_crs(:,:,:,:) = 0._wp 
    274             ztmp(:,:,:)=1. 
    275  
    276             zt(:,:,:) = 0._wp 
    277             zs(:,:,:) = 0._wp 
    278             DO jk=2,jpk  
    279                WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) / fse3w(:,:,jk) 
    280                zt(:,:,jk)=  avt(:,:,jk) *  zs(:,:,jk) 
    281             ENDDO 
    282             CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
    283             CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
    284             zt_crs=tmask_crs*zt_crs 
    285             WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,1) = zt_crs / zs_crs 
    286  
    287             zt(:,:,:) = 0._wp 
    288             zs(:,:,:) = 0._wp 
    289             DO jk=2,jpk  
    290                WHERE( fse3w(:,:,jk) .NE. 0._wp) zs(:,:,jk) = ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) / fse3w(:,:,jk) 
    291                zt(:,:,jk)=  avt(:,:,jk) *  zs(:,:,jk) 
    292             ENDDO 
    293             CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
    294             CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
    295             zt_crs=tmask_crs*zt_crs 
    296             WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,2) = zt_crs / zs_crs 
    297  
    298             zt(:,:,:) = 0._wp 
    299             zs(:,:,:) = 0._wp 
    300             DO jk=2,jpk 
    301                 WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) +  & 
    302                                                                   &   rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk)  
    303                 zt(:,:,jk)=  avt(:,:,jk) *  zs(:,:,jk)                                                            
    304             ENDDO 
    305             CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
    306             CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
    307             zt_crs=tmask_crs*zt_crs 
    308             WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,3) = zt_crs / zs_crs 
    309  
    310             zt(:,:,:) = 0._wp 
    311             zs(:,:,:) = 0._wp 
    312             DO jk=2,jpk 
    313                 WHERE( fse3w(:,:,jk) .NE. 0._wp ) zs(:,:,jk)= ( rn_a0 * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) -  & 
    314                                                                   &   rn_b0 * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) )/ fse3w(:,:,jk)  
    315                 zt(:,:,jk)=  avt(:,:,jk) *  zs(:,:,jk) 
    316             ENDDO 
    317             CALL crs_dom_ope( zt, 'VOL', 'W', tmask, zt_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
    318             CALL crs_dom_ope( zs, 'VOL', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=ztmp, psgn=1.0 ) 
    319             zt_crs=tmask_crs*zt_crs 
    320             WHERE( zs_crs .NE. 0._wp ) avte_crs(:,:,:,4) = zt_crs / zs_crs 
    321  
    322             CALL iom_put( "avte_crs1", avte_crs(:,:,:,1) )   !  Kz 
    323             CALL iom_put( "avte_crs2", avte_crs(:,:,:,2) )   !  Kz 
    324             CALL iom_put( "avte_crs3", avte_crs(:,:,:,3) )   !  Kz 
    325             CALL iom_put( "avte_crs4", avte_crs(:,:,:,4) )   !  Kz 
    326  
    327             CALL crs_dom_ope( avt, 'MED', 'W', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3w, p_mask_crs=tmask_crs, psgn=1.0 ) 
    328             CALL iom_put( "zs_crs", zs_crs )   !  Kzlogvol 
    329  
    330             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, zmax_crs, p_e12=e1e2t, p_e3=zfse3w,  psgn=1.0 ) 
    331             CALL iom_put( "zmax_crs", zmax_crs )   !  Kzlogvol 
    332             avt_crs=zs_crs 
    333  
    334  
    335             zerr0=0.01 
    336  
    337             icnt1=0 
    338             icnt2=0 
    339  
    340             zt_crs(:,:,:)=0._wp 
    341             zerr_crs(:,:,:)=0._wp 
    342             DO ji=1,jpi_crs  
    343             DO jj=1,jpj_crs  
    344             DO jk=1,jpk 
    345  
    346   
    347                zwgt(1:4)=0._wp 
    348                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 
    349                IF( SUM(zwgt(1:4)) .NE. 0._wp ) THEN   
    350                   zmean = SUM( zwgt(1:4)*avte_crs(ji,jj,jk,1:4)) / SUM(zwgt(1:4) ) 
    351                   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) ) ) 
    352                ELSE 
    353                   zmean=0._wp 
    354                  zerr=1.e10 
    355                ENDIF 
    356  
    357                zerr_crs(ji,jj,jk)=zerr 
    358  
    359                IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )zt_crs(ji,jj,jk)=zmean 
    360                IF( zerr .LE. zerr0 .AND. zmean .GT. 0._wp )avt_crs(ji,jj,jk)=zmean 
    361  
    362                IF( tmask_crs(ji,jj,jk) == 1 ) icnt1=icnt1+1 
    363                IF( tmask_crs(ji,jj,jk) == 1 .AND.  zerr .LE. zerr0 .AND. zmean .GT. 0._wp ) icnt2=icnt2+1 
    364  
    365             ENDDO 
    366             ENDDO 
    367             ENDDO 
    368  
    369             CALL iom_put( "zt_crs", zt_crs )   !  Kz 
    370             CALL iom_put( "zerr_crs", zerr_crs )   !  Kz 
    371265 
    372266      END SELECT 
    … …  
    477371      CALL wrk_dealloc( jpi, jpj, jpk, zt, zs, ztmp   ) 
    478372      CALL wrk_dealloc( jpi, jpj, z2d                 ) 
    479       CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs, zerr_crs,zmax_crs ) 
    480       CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, ztmp_crs ) 
    481       CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, 4, avte_crs ) 
     373      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) 
    482374      CALL wrk_dealloc( jpi_crs, jpj_crs, z2d_crs     ) 
    483375      ! 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r6772 r6786  
    4343         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    4444         CALL iom_put( TRIM(cltra), trn(:,:,:,jn) ) 
    45          ENDIF 
    4645      END DO 
    4746      ! 
Note: See TracChangeset for help on using the changeset viewer.