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 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/diawri.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

Location:
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals

      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/SAS/diawri.F90

    r12178 r12928  
    2424   !!---------------------------------------------------------------------- 
    2525   USE oce             ! ocean dynamics and tracers  
     26   USE abl            ! abl variables in case ln_abl = .true. 
    2627   USE dom_oce         ! ocean space and time domain 
    2728   USE zdf_oce         ! ocean vertical physics 
    … …  
    5152   PUBLIC   dia_wri_state 
    5253   PUBLIC   dia_wri_alloc           ! Called by nemogcm module 
    53  
     54#if ! defined key_iomput    
     55   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.) 
     56#endif 
    5457   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
    5558   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file 
    5659   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
     60   INTEGER ::   ndim_A, ndim_hA                      ! ABL file    
     61   INTEGER ::   nid_A, nz_A, nh_A                    ! grid_ABL file    
    5762   INTEGER ::   ndex(1)                              ! ??? 
    5863   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
    59  
    60    !! * Substitutions 
    61 #  include "vectopt_loop_substitute.h90" 
     64   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 
     65 
    6266   !!---------------------------------------------------------------------- 
    6367   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
    … …  
    7882 
    7983    
    80    SUBROUTINE dia_wri( kt ) 
     84   SUBROUTINE dia_wri( kt, Kmm ) 
    8185      !!--------------------------------------------------------------------- 
    8286      !!                  ***  ROUTINE dia_wri  *** 
    … …  
    9094      !! 
    9195      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     96      INTEGER, INTENT( in ) ::   Kmm     ! ocean time levelindex 
    9297      !!---------------------------------------------------------------------- 
    9398      !  
    9499      ! Output the initial state and forcings 
    95100      IF( ninist == 1 ) THEN 
    96          CALL dia_wri_state( 'output.init' ) 
     101         CALL dia_wri_state( Kmm, 'output.init' ) 
    97102         ninist = 0 
    98103      ENDIF 
    … …  
    114119   END FUNCTION dia_wri_alloc 
    115120    
     121   INTEGER FUNCTION dia_wri_alloc_abl() 
     122      !!---------------------------------------------------------------------- 
     123     ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl) 
     124      CALL mpp_sum( 'diawri', dia_wri_alloc_abl ) 
     125      ! 
     126   END FUNCTION dia_wri_alloc_abl 
    116127   
    117    SUBROUTINE dia_wri( kt ) 
     128   SUBROUTINE dia_wri( kt, Kmm ) 
    118129      !!--------------------------------------------------------------------- 
    119130      !!                  ***  ROUTINE dia_wri  *** 
    … …  
    129140      !! 
    130141      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     142      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index 
    131143      !! 
    132144      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
    … …  
    136148      INTEGER  ::   ierr                                     ! error code return from allocation 
    137149      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
     150      INTEGER  ::   ipka                                     ! ABL 
    138151      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars 
     152      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace 
    139153      !!---------------------------------------------------------------------- 
    140154      ! 
    141155      ! Output the initial state and forcings 
    142156      IF( ninist == 1 ) THEN                        
    143          CALL dia_wri_state( 'output.init' ) 
     157         CALL dia_wri_state( Kmm, 'output.init' ) 
    144158         ninist = 0 
    145159      ENDIF 
    … …  
    161175      ENDIF 
    162176#if defined key_diainstant 
    163       zsto = nn_write * rdt 
     177      zsto = nn_write * rn_Dt 
    164178      clop = "inst("//TRIM(clop)//")" 
    165179#else 
    166       zsto=rdt 
     180      zsto=rn_Dt 
    167181      clop = "ave("//TRIM(clop)//")" 
    168182#endif 
    169       zout = nn_write * rdt 
    170       zmax = ( nitend - nit000 + 1 ) * rdt 
     183      zout = nn_write * rn_Dt 
     184      zmax = ( nitend - nit000 + 1 ) * rn_Dt 
    171185 
    172186      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    174188      ijmi = 1      ;      ijma = jpj 
    175189      ipk = jpk 
     190     IF(ln_abl) ipka = jpkam1 
    176191 
    177192      ! define time axis 
    … …  
    188203 
    189204         ! Compute julian date from starting date of the run 
    190          CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
     205         CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 
    191206         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    192207         IF(lwp)WRITE(numout,*) 
    … …  
    210225         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    211226            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    212             &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 
     227            &          nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 
    213228         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept 
    214229            &           "m", ipk, gdept_1d, nz_T, "down" ) 
    … …  
    222237         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu 
    223238            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    224             &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 
     239            &          nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 
    225240         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept 
    226241            &           "m", ipk, gdept_1d, nz_U, "down" ) 
    … …  
    234249         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv 
    235250            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    236             &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 
     251            &          nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 
    237252         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept 
    238253            &          "m", ipk, gdept_1d, nz_V, "down" ) 
    … …  
    241256 
    242257         ! No W grid FILE 
     258         IF( ln_abl ) THEN  
     259         ! Define the ABL grid FILE ( nid_A ) 
     260            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 
     261            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
     262            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
     263               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
     264               &          nit000-1, zjulian, rn_Dt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set ) 
     265            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept 
     266               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" ) 
     267            !                                                            ! Index of ocean points 
     268         ALLOCATE( zw3d_abl(jpi,jpj,ipka) )  
     269         zw3d_abl(:,:,:) = 1._wp  
     270         CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume 
     271            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface 
     272         DEALLOCATE(zw3d_abl) 
     273         ENDIF 
    243274 
    244275         ! Declare all the output fields as NETCDF variables 
    … …  
    261292         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm 
    262293            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     294! 
     295         IF( ln_abl ) THEN 
     296         !                                                                                      !!! nid_A : 3D 
     297         CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl 
     298               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     299            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl 
     300               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     301            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl 
     302               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     303            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl 
     304               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     305            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl 
     306               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     307            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl 
     308               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     309            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl 
     310               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     311            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh 
     312               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )                  
     313#if defined key_si3 
     314            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i 
     315               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout ) 
     316#endif 
     317          CALL histend( nid_A, snc4chunks=snc4set ) 
     318       ! 
     319       ENDIF 
     320! 
    263321 
    264322         CALL histend( nid_T, snc4chunks=snc4set ) 
    … …  
    310368      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction    
    311369      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed    
     370! 
     371      IF( ln_abl ) THEN  
     372        ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) 
     373        IF( ln_mskland )   THEN  
     374          DO jk=1,jpka 
     375             zw3d_abl(:,:,jk) = tmask(:,:,1) 
     376            END DO 
     377       ELSE 
     378            zw3d_abl(:,:,:) = 1._wp      
     379         ENDIF        
     380       CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh  
     381        CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl 
     382        CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl 
     383        CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl 
     384        CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl      
     385        CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl 
     386        CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl 
     387        CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl   
     388#if defined key_si3 
     389         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i 
     390#endif 
     391       DEALLOCATE(zw3d_abl) 
     392     ENDIF 
     393! 
    312394 
    313395         ! Write fields on U grid 
    … …  
    325407         CALL histclo( nid_U ) 
    326408         CALL histclo( nid_V ) 
     409         IF(ln_abl) CALL histclo( nid_A ) 
    327410      ENDIF 
    328411      ! 
    … …  
    332415#endif 
    333416 
    334    SUBROUTINE dia_wri_state( cdfile_name ) 
     417   SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 
    335418      !!--------------------------------------------------------------------- 
    336419      !!                 ***  ROUTINE dia_wri_state  *** 
    … …  
    345428      !!      File 'output.abort.nc' is created in case of abnormal job end 
    346429      !!---------------------------------------------------------------------- 
     430      INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex 
    347431      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    348432      !! 
    … …  
    354438      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    355439      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
    356  
    357 #if defined key_si3 
    358      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
    359 #else 
    360      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
    361 #endif 
    362  
    363       CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
    364       CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
    365       CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
    366       CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
    367       CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
    368       CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
    369       CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget 
    370       CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux 
    371       CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux 
    372       CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction 
    373       CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
    374       CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
    375   
     440      ! 
     441      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
     442      ! 
     443      CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) )    ! now temperature 
     444      CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) )    ! now salinity 
     445      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,         Kmm) )    ! sea surface height 
     446      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu (:,:,:,       Kmm) )    ! now i-velocity 
     447      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv (:,:,:,       Kmm) )    ! now j-velocity 
     448      CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww                    )    ! now k-velocity 
     449      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf             )    ! freshwater budget 
     450      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns             )    ! total heat flux 
     451      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr                   )    ! solar heat flux 
     452      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i                  )    ! ice fraction 
     453      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau                  )    ! i-wind stress 
     454      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau                  )    ! j-wind stress 
     455      ! 
     456      CALL iom_close( inum ) 
     457      ! 
    376458#if defined key_si3 
    377459      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
     460         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    378461         CALL ice_wri_state( inum ) 
    379       ENDIF 
    380 #endif 
    381       ! 
    382       CALL iom_close( inum ) 
    383       ! 
     462         CALL iom_close( inum ) 
     463      ENDIF 
     464#endif 
     465 
    384466   END SUBROUTINE dia_wri_state 
    385467 
Note: See TracChangeset for help on using the changeset viewer.