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 10425 for NEMO/trunk/tests/CANAL/MY_SRC/diawri.F90 – NEMO

Ignore:
Timestamp:
2018-12-19T22:54:16+01:00 (5 years ago)
Author:
smasson
Message:

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/tests/CANAL/MY_SRC/diawri.F90

    r10074 r10425  
    5252 
    5353#if defined key_si3 
     54   USE ice  
    5455   USE icewri  
    5556#endif 
     
    8990   !!   'key_iomput'                                        use IOM library 
    9091   !!---------------------------------------------------------------------- 
    91  
    9292   INTEGER FUNCTION dia_wri_alloc() 
    9393      ! 
     
    9696   END FUNCTION dia_wri_alloc 
    9797 
    98  
     98    
    9999   SUBROUTINE dia_wri( kt ) 
    100100      !!--------------------------------------------------------------------- 
     
    123123      ! Output the initial state and forcings 
    124124      IF( ninist == 1 ) THEN                        
    125          CALL dia_wri_state( 'output.init', kt ) 
     125         CALL dia_wri_state( 'output.init' ) 
    126126         ninist = 0 
    127127      ENDIF 
     
    129129      ! Output of initial vertical scale factor 
    130130      CALL iom_put("e3t_0", e3t_0(:,:,:) ) 
    131       CALL iom_put("e3u_0", e3t_0(:,:,:) ) 
    132       CALL iom_put("e3v_0", e3t_0(:,:,:) ) 
     131      CALL iom_put("e3u_0", e3u_0(:,:,:) ) 
     132      CALL iom_put("e3v_0", e3v_0(:,:,:) ) 
    133133      ! 
    134134      CALL iom_put( "e3t" , e3t_n(:,:,:) ) 
     
    185185            END DO 
    186186         END DO 
    187          CALL lbc_lnk( z2d, 'T', 1. ) 
     187         CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
    188188         CALL iom_put( "taubot", z2d )            
    189189      ENDIF 
     
    244244            END DO 
    245245         END DO 
    246          CALL lbc_lnk( z3d, 'T', 1. ) 
     246         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    247247         CALL iom_put( "salgrad2",  z3d )          ! square of module of sal gradient 
    248248         z3d(:,:,:) = SQRT( z3d(:,:,:) ) 
     
    260260            END DO 
    261261         END DO 
    262          CALL lbc_lnk( z2d, 'T', 1. ) 
     262         CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
    263263         CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient 
    264264         z2d(:,:) = SQRT( z2d(:,:) ) 
     
    314314            END DO 
    315315         END DO 
    316          CALL lbc_lnk( z3d, 'T', 1. ) 
     316         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    317317         CALL iom_put( "eken", z3d )                 ! kinetic energy 
    318318      ENDIF 
     
    335335         END DO 
    336336          
    337          CALL lbc_lnk( z3d, 'T', 1. ) 
     337         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    338338         CALL iom_put( "ke", z3d ) ! kinetic energy 
    339339 
     
    363363            END DO 
    364364         END DO 
    365          CALL lbc_lnk( z3d, 'F', 1. ) 
     365         CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 
    366366         CALL iom_put( "relvor", z3d )                  ! relative vorticity 
    367367 
     
    387387            END DO 
    388388         END DO 
    389          CALL lbc_lnk( z3d, 'F', 1. ) 
     389         CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 
    390390         CALL iom_put( "potvor", z3d )                  ! potential vorticity 
    391391 
     
    413413            END DO 
    414414         END DO 
    415          CALL lbc_lnk( z2d, 'U', -1. ) 
     415         CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 
    416416         CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction 
    417417      ENDIF 
     
    426426            END DO 
    427427         END DO 
    428          CALL lbc_lnk( z2d, 'U', -1. ) 
     428         CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 
    429429         CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction 
    430430      ENDIF 
     
    448448            END DO 
    449449         END DO 
    450          CALL lbc_lnk( z2d, 'V', -1. ) 
     450         CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 
    451451         CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction 
    452452      ENDIF 
     
    461461            END DO 
    462462         END DO 
    463          CALL lbc_lnk( z2d, 'V', -1. ) 
     463         CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 
    464464         CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction 
    465465      ENDIF 
     
    474474            END DO 
    475475         END DO 
    476          CALL lbc_lnk( z2d, 'T', -1. ) 
     476         CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 
    477477         CALL iom_put( "tosmint", rau0 * z2d )        ! Vertical integral of temperature 
    478478      ENDIF 
     
    486486            END DO 
    487487         END DO 
    488          CALL lbc_lnk( z2d, 'T', -1. ) 
     488         CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 
    489489         CALL iom_put( "somint", rau0 * z2d )         ! Vertical integral of salinity 
    490490      ENDIF 
     
    505505   !!   Default option                                  use IOIPSL  library 
    506506   !!---------------------------------------------------------------------- 
    507     
     507 
    508508   INTEGER FUNCTION dia_wri_alloc() 
    509509      !!---------------------------------------------------------------------- 
     
    516516         ! 
    517517      dia_wri_alloc = MAXVAL(ierr) 
    518       IF( lk_mpp )   CALL mpp_sum( dia_wri_alloc ) 
     518      CALL mpp_sum( 'diawri', dia_wri_alloc ) 
    519519      ! 
    520520   END FUNCTION dia_wri_alloc 
    521    
    522    
     521 
     522    
    523523   SUBROUTINE dia_wri( kt ) 
    524524      !!--------------------------------------------------------------------- 
     
    551551      ! 
    552552      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==! 
    553          CALL dia_wri_state( 'output.init', kt ) 
     553         CALL dia_wri_state( 'output.init' ) 
    554554         ninist = 0 
    555555      ENDIF 
     
    625625            !! that routine is called from nemogcm, so do it here immediately before its needed 
    626626            ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror ) 
    627             IF( lk_mpp )   CALL mpp_sum( ierror ) 
     627            CALL mpp_sum( 'diawri', ierror ) 
    628628            IF( ierror /= 0 ) THEN 
    629629               CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array') 
     
    974974#endif 
    975975 
    976    SUBROUTINE dia_wri_state( cdfile_name, kt ) 
     976   SUBROUTINE dia_wri_state( cdfile_name ) 
    977977      !!--------------------------------------------------------------------- 
    978978      !!                 ***  ROUTINE dia_wri_state  *** 
     
    988988      !!---------------------------------------------------------------------- 
    989989      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    990       INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index 
    991       !!  
    992       CHARACTER (len=32) :: clname 
    993       CHARACTER (len=40) :: clop 
    994       INTEGER  ::   id_i , nz_i, nh_i        
    995       INTEGER, DIMENSION(1) ::   idex             ! local workspace 
    996       REAL(wp) ::   zsto, zout, zmax, zjulian 
     990      !! 
     991      INTEGER :: inum 
    997992      !!---------------------------------------------------------------------- 
    998993      !  
    999       ! 0. Initialisation 
    1000       ! ----------------- 
    1001  
    1002       ! Define name, frequency of output and means 
    1003       clname = cdfile_name 
    1004       IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    1005       zsto = rdt 
    1006       clop = "inst(x)"           ! no use of the mask value (require less cpu time) 
    1007       zout = rdt 
    1008       zmax = ( nitend - nit000 + 1 ) * rdt 
    1009  
    1010994      IF(lwp) WRITE(numout,*) 
    1011995      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 
    1012996      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    1013       IF(lwp) WRITE(numout,*) '                and named :', clname, '.nc' 
    1014  
    1015  
    1016       ! 1. Define NETCDF files and fields at beginning of first time step 
    1017       ! ----------------------------------------------------------------- 
    1018  
    1019       ! Compute julian date from starting date of the run 
    1020       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis  
    1021       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    1022       CALL histbeg( clname, jpi, glamt, jpj, gphit,   & 
    1023           1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 
    1024       CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept 
    1025           "m", jpk, gdept_1d, nz_i, "down") 
    1026  
    1027       ! Declare all the output fields as NetCDF variables 
    1028  
    1029       CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity 
    1030          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1031       CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature 
    1032          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1033       CALL histdef( id_i, "sossheig", "Sea Surface Height"    , "m"      ,   &  ! ssh 
    1034          &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout ) 
    1035       CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current 
    1036          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1037       CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current 
    1038          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    1039       CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current 
    1040          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    1041          ! 
     997      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
     998 
     999#if defined key_si3 
     1000     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
     1001#else 
     1002     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
     1003#endif 
     1004 
     1005      CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
     1006      CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
     1007      CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
     1008      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
     1009      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
     1010      CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
    10421011      IF( ALLOCATED(ahtu) ) THEN 
    1043          CALL histdef( id_i, "ahtu"    , "u-eddy diffusivity"    , "m2/s"    ,   &   ! zonal current 
    1044             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1045          CALL histdef( id_i, "ahtv"    , "v-eddy diffusivity"    , "m2/s"    ,   &   ! meridonal current 
    1046             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    1047       ENDIF 
    1048       IF( ALLOCATED(ahmt) ) THEN  
    1049          CALL histdef( id_i, "ahmt"    , "t-eddy viscosity"      , "m2/s"    ,   &   ! zonal current 
    1050             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1051          CALL histdef( id_i, "ahmf"    , "f-eddy viscosity"      , "m2/s"    ,   &   ! meridonal current 
    1052             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    1053       ENDIF 
    1054          ! 
    1055       CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater  
    1056          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1057       CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux 
    1058          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1059       CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux 
    1060          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1061       CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i 
    1062          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1063       CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress 
    1064          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1065       CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress 
    1066          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    1067       IF( .NOT.ln_linssh ) THEN 
    1068          CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      , &   ! t-point depth 
    1069             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1070          CALL histdef( id_i, "vovvle3t", "T point thickness"     , "m"      , &   ! t-point depth 
    1071             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1072       ENDIF 
    1073       ! 
     1012         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point 
     1013         CALL iom_rstput( 0, 0, inum,  'ahtv', ahtv              )    ! aht at v-point 
     1014      ENDIF 
     1015      IF( ALLOCATED(ahmt) ) THEN 
     1016         CALL iom_rstput( 0, 0, inum,  'ahmt', ahmt              )    ! ahmt at u-point 
     1017         CALL iom_rstput( 0, 0, inum,  'ahmf', ahmf              )    ! ahmf at v-point 
     1018      ENDIF 
     1019      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget 
     1020      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux 
     1021      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux 
     1022      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction 
     1023      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
     1024      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
     1025      IF(  .NOT.ln_linssh  ) THEN              
     1026         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n        )    !  T-cell depth  
     1027         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n          )    !  T-cell thickness   
     1028      END IF 
    10741029      IF( ln_wave .AND. ln_sdw ) THEN 
    1075          CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal"    , "m/s"    , &   ! StokesDrift zonal current 
    1076             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1077          CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid"    , "m/s"    , &   ! StokesDrift meridonal current 
    1078             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1079          CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert"     , "m/s"    , &   ! StokesDrift vertical current 
    1080             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    1081       ENDIF 
    1082  
     1030         CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd            )    ! now StokesDrift i-velocity 
     1031         CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd            )    ! now StokesDrift j-velocity 
     1032         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity 
     1033      ENDIF 
     1034  
    10831035#if defined key_si3 
    10841036      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
    1085          CALL ice_wri_state( kt, id_i, nh_i ) 
    1086       ENDIF 
    1087 #else 
    1088       CALL histend( id_i, snc4chunks=snc4set ) 
     1037         CALL ice_wri_state( inum ) 
     1038      ENDIF 
    10891039#endif 
    1090  
    1091       ! 2. Start writing data 
    1092       ! --------------------- 
    1093       ! idex(1) est utilise ssi l'avant dernier argument est diffferent de  
    1094       ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 
    1095       ! donne le nombre d'elements, et idex la liste des indices a sortir 
    1096       idex(1) = 1   ! init to avoid compil warning 
    1097  
    1098       ! Write all fields on T grid 
    1099       CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature 
    1100       CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity 
    1101       CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height 
    1102       CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity 
    1103       CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
    1104       CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
    1105       ! 
    1106       IF( ALLOCATED(ahtu) ) THEN 
    1107          CALL histwrite( id_i, "ahtu"    , kt, ahtu             , jpi*jpj*jpk, idex )    ! aht at u-point 
    1108          CALL histwrite( id_i, "ahtv"    , kt, ahtv             , jpi*jpj*jpk, idex )    !  -  at v-point 
    1109       ENDIF 
    1110       IF( ALLOCATED(ahmt) ) THEN 
    1111          CALL histwrite( id_i, "ahmt"    , kt, ahmt             , jpi*jpj*jpk, idex )    ! ahm at t-point 
    1112          CALL histwrite( id_i, "ahmf"    , kt, ahmf             , jpi*jpj*jpk, idex )    !  -  at f-point 
    1113       ENDIF 
    1114       ! 
    1115       CALL histwrite( id_i, "sowaflup", kt, emp - rnf        , jpi*jpj    , idex )    ! freshwater budget 
    1116       CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
    1117       CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
    1118       CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction 
    1119       CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress 
    1120       CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
    1121  
    1122       IF(  .NOT.ln_linssh  ) THEN              
    1123          CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth  
    1124          CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )!  T-cell thickness   
    1125       END IF  
    1126   
    1127       IF( ln_wave .AND. ln_sdw ) THEN 
    1128          CALL histwrite( id_i, "sdzocrtx", kt, usd           , jpi*jpj*jpk, idex)     ! now StokesDrift i-velocity 
    1129          CALL histwrite( id_i, "sdmecrty", kt, vsd           , jpi*jpj*jpk, idex)     ! now StokesDrift j-velocity 
    1130          CALL histwrite( id_i, "sdvecrtz", kt, wsd           , jpi*jpj*jpk, idex)     ! now StokesDrift k-velocity 
    1131       ENDIF 
    1132  
    1133       ! 3. Close the file 
    1134       ! ----------------- 
    1135       CALL histclo( id_i ) 
    1136 #if ! defined key_iomput 
    1137       IF( ninist /= 1  ) THEN 
    1138          CALL histclo( nid_T ) 
    1139          CALL histclo( nid_U ) 
    1140          CALL histclo( nid_V ) 
    1141          CALL histclo( nid_W ) 
    1142       ENDIF 
    1143 #endif 
     1040      ! 
     1041      CALL iom_close( inum ) 
    11441042      !  
    11451043   END SUBROUTINE dia_wri_state 
Note: See TracChangeset for help on using the changeset viewer.