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 12593 for NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/stpctl.F90 – NEMO

Ignore:
Timestamp:
2020-03-24T16:52:17+01:00 (4 years ago)
Author:
smasson
Message:

r12581_ticket2418, first commit see #2418

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/stpctl.F90

    r12254 r12593  
    3131   PUBLIC stp_ctl           ! routine called by step.F90 
    3232 
    33    INTEGER  ::   idrun, idtime, idtau, idqns, idemp, istatus 
    34    LOGICAL  ::   lsomeoce 
     33   INTEGER  ::   nrunid, ntauid, nqnsid, nempid 
    3534   !!---------------------------------------------------------------------- 
    3635   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
     
    4039CONTAINS 
    4140 
    42    SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic ) 
     41   SUBROUTINE stp_ctl( kt, Kbb, Kmm ) 
    4342      !!---------------------------------------------------------------------- 
    4443      !!                    ***  ROUTINE stp_ctl  *** 
     
    5655      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    5756      INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index 
    58       INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    5957      !! 
     58      INTEGER                ::   idtime, istatus 
    6059      REAL(wp), DIMENSION(3) ::   zmax 
    6160      LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
     61      LOGICAL, DIMENSION(jpi,jpj) ::   llmsk 
    6262      CHARACTER(len=20) :: clname 
    6363      !!---------------------------------------------------------------------- 
    6464      ! 
    65       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    66       ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
     65      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     66      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat 
    6767      ll_wrtruns = ll_colruns .AND. lwm 
    68       IF( kt == nit000 .AND. lwp ) THEN 
    69          WRITE(numout,*) 
    70          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    71          WRITE(numout,*) '~~~~~~~' 
    72          !                                ! open time.step file 
    73          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    74          !                                ! open run.stat file(s) at start whatever 
    75          !                                ! the value of sn_cfctl%ptimincr 
    76          IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
     68      ! 
     69      IF( kt == nit000 ) THEN 
     70         ! 
     71         IF( lwp ) THEN 
     72            WRITE(numout,*) 
     73            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     74            WRITE(numout,*) '~~~~~~~' 
     75         ENDIF 
     76         !                                ! open time.step    ascii file, done only by 1st subdomain 
     77         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     78         ! 
     79         IF( ll_wrtruns ) THEN 
     80            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    7781            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     82            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    7883            clname = 'run.stat.nc' 
    7984            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    80             istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    81             istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    82             istatus = NF90_DEF_VAR( idrun, 'tau_max', NF90_DOUBLE, (/ idtime /), idtau ) 
    83             istatus = NF90_DEF_VAR( idrun, 'qns_max', NF90_DOUBLE, (/ idtime /), idqns   ) 
    84             istatus = NF90_DEF_VAR( idrun, 'emp_max', NF90_DOUBLE, (/ idtime /), idemp   ) 
    85             istatus = NF90_ENDDEF(idrun) 
     85            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     86            istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 
     87            istatus = NF90_DEF_VAR( nrunid, 'tau_max', NF90_DOUBLE, (/ idtime /), ntauid ) 
     88            istatus = NF90_DEF_VAR( nrunid, 'qns_max', NF90_DOUBLE, (/ idtime /), nqnsid   ) 
     89            istatus = NF90_DEF_VAR( nrunid, 'emp_max', NF90_DOUBLE, (/ idtime /), nempid   ) 
     90            istatus = NF90_ENDDEF(nrunid) 
    8691         ENDIF 
     92         !     
    8793      ENDIF 
    88       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    8994      ! 
    90       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     95      !                                   !==              write current time step              ==! 
     96      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     97      IF( lwm .AND. ll_wrtstp ) THEN 
    9198         WRITE ( numstp, '(1x, i8)' )   kt 
    9299         REWIND( numstp ) 
    93100      ENDIF 
    94       ! 
    95       !                                   !==  test of extrema  ==! 
    96       zmax(1) = MAXVAL(     taum(:,:)   , mask = tmask(:,:,1) == 1._wp )                                         ! max wind stress module 
    97       zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = tmask(:,:,1) == 1._wp )                                         ! max non-solar heat flux 
    98       zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = tmask(:,:,1) == 1._wp )                                         ! max E-P 
     101      !                                   !==            test of local extrema           ==! 
     102      !                                   !==  done by all processes at every time step  ==! 
     103      llmsk(:,:) = tmask(:,:,1) == 1._wp 
     104      zmax(1) = MAXVAL(     taum(:,:)   , mask = llmsk )   ! max wind stress module 
     105      zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = llmsk )   ! max non-solar heat flux 
     106      zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = llmsk )   ! max E-P 
    99107      ! 
    100108      IF( ll_colruns ) THEN 
     
    105113      IF( ll_wrtruns ) THEN 
    106114         WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3) 
    107          istatus = NF90_PUT_VAR( idrun, idtau, (/ zmax(1)/), (/kt/), (/1/) ) 
    108          istatus = NF90_PUT_VAR( idrun, idqns, (/ zmax(2)/), (/kt/), (/1/) ) 
    109          istatus = NF90_PUT_VAR( idrun, idemp, (/ zmax(3)/), (/kt/), (/1/) ) 
    110          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    111          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
     115         istatus = NF90_PUT_VAR( nrunid, ntauid, (/ zmax(1)/), (/kt/), (/1/) ) 
     116         istatus = NF90_PUT_VAR( nrunid, nqnsid, (/ zmax(2)/), (/kt/), (/1/) ) 
     117         istatus = NF90_PUT_VAR( nrunid, nempid, (/ zmax(3)/), (/kt/), (/1/) ) 
     118         IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(nrunid) 
     119         IF( kt == nitend         ) istatus = NF90_CLOSE(nrunid) 
    112120      END IF 
    113121      !                                   !==  error handling  ==! 
Note: See TracChangeset for help on using the changeset viewer.