Ignore:
Timestamp:
2020-06-26T10:26:32+02:00 (15 months ago)
Author:
gsamson
Message:

merge trunk@r13136 into ASINTER-06 branch; pass all SETTE tests; results identical to trunk@r13136; ticket #2419

Location:
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement

    • Property svn:externals
      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@12931        sette 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/diawri.F90

    r12489 r13159  
    9999      ! Output the initial state and forcings 
    100100      IF( ninist == 1 ) THEN 
    101          CALL dia_wri_state( 'output.init', Kmm ) 
     101         CALL dia_wri_state( Kmm, 'output.init' ) 
    102102         ninist = 0 
    103103      ENDIF 
     
    126126   END FUNCTION dia_wri_alloc_abl 
    127127   
    128    SUBROUTINE dia_wri( kt ) 
     128   SUBROUTINE dia_wri( kt, Kmm ) 
    129129      !!--------------------------------------------------------------------- 
    130130      !!                  ***  ROUTINE dia_wri  *** 
     
    138138      !!      Each nn_write time step, output the instantaneous or mean fields 
    139139      !!---------------------------------------------------------------------- 
    140       !! 
    141140      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     141      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index 
    142142      !! 
    143143      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
     
    154154      ! Output the initial state and forcings 
    155155      IF( ninist == 1 ) THEN                        
    156          CALL dia_wri_state( 'output.init' ) 
     156         CALL dia_wri_state( Kmm, 'output.init' ) 
    157157         ninist = 0 
    158158      ENDIF 
     
    257257         IF( ln_abl ) THEN  
    258258         ! Define the ABL grid FILE ( nid_A ) 
    259             CALL dia_nam( clhstnam, nwrite, 'grid_ABL' ) 
     259            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 
    260260            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
    261261            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
     
    414414#endif 
    415415 
    416    SUBROUTINE dia_wri_state( cdfile_name, Kmm ) 
     416   SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 
    417417      !!--------------------------------------------------------------------- 
    418418      !!                 ***  ROUTINE dia_wri_state  *** 
     
    427427      !!      File 'output.abort.nc' is created in case of abnormal job end 
    428428      !!---------------------------------------------------------------------- 
     429      INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex 
    429430      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    430       INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex 
    431431      !! 
    432432      INTEGER :: inum 
     
    437437      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    438438      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
    439  
    440 #if defined key_si3 
    441      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
    442 #else 
    443      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
    444 #endif 
    445  
     439      ! 
     440      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
     441      ! 
    446442      CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) )    ! now temperature 
    447443      CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) )    ! now salinity 
     
    456452      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau                  )    ! i-wind stress 
    457453      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau                  )    ! j-wind stress 
    458   
     454      ! 
     455      CALL iom_close( inum ) 
     456      ! 
    459457#if defined key_si3 
    460458      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
     459         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    461460         CALL ice_wri_state( inum ) 
    462       ENDIF 
    463 #endif 
    464       ! 
    465       CALL iom_close( inum ) 
    466       ! 
     461         CALL iom_close( inum ) 
     462      ENDIF 
     463      ! 
     464#endif 
    467465   END SUBROUTINE dia_wri_state 
    468466 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/nemogcm.F90

    r12489 r13159  
    3535   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
    3636   ! 
     37   USE in_out_manager ! I/O manager 
    3738   USE lib_mpp        ! distributed memory computing 
    3839   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     
    125126      END DO 
    126127      ! 
    127       IF( .NOT. Agrif_Root() ) THEN 
    128          CALL Agrif_ParentGrid_To_ChildGrid() 
    129          IF( ln_timing )   CALL timing_finalize 
    130          CALL Agrif_ChildGrid_To_ParentGrid() 
    131       ENDIF 
    132       ! 
    133128#else 
    134129      ! 
     
    165160      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    166161         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    167          CALL ctl_stop( ctmp1 ) 
     162         IF( ngrdstop > 0 ) THEN 
     163            WRITE(ctmp9,'(i2)') ngrdstop 
     164            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9) 
     165            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 
     166            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 
     167         ELSE 
     168            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     169            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
     170         ENDIF 
    168171      ENDIF 
    169172      ! 
     
    256259      ENDIF 
    257260      ! open /dev/null file to be able to supress output write easily 
     261      IF( Agrif_Root() ) THEN 
    258262                     CALL ctl_opn(     numnul,               '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     263#ifdef key_agrif 
     264      ELSE 
     265                  numnul = Agrif_Parent(numnul)    
     266#endif 
     267      ENDIF 
    259268      ! 
    260269      !                             !--------------------! 
     
    268277      ! 
    269278      ! finalize the definition of namctl variables 
    270       IF( sn_cfctl%l_allon ) THEN 
    271          ! Turn on all options. 
    272          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    273          ! Ensure all processors are active 
    274          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    275       ELSEIF( sn_cfctl%l_config ) THEN 
    276          ! Activate finer control of report outputs 
    277          ! optionally switch off output from selected areas (note this only 
    278          ! applies to output which does not involve global communications) 
    279          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    280            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    281            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    282       ELSE 
    283          ! turn off all options. 
    284          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    285       ENDIF 
     279      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     280         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    286281      ! 
    287282      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
     
    401396         WRITE(numout,*) '~~~~~~~~' 
    402397         WRITE(numout,*) '   Namelist namctl' 
    403          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    404          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    405          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    406398         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    407399         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
     
    545537   END SUBROUTINE nemo_alloc 
    546538 
    547    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     539   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    548540      !!---------------------------------------------------------------------- 
    549541      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    550542      !! 
    551543      !! ** Purpose :   Set elements of the output control structure to setto. 
    552       !!                for_all should be .false. unless all areas are to be 
    553       !!                treated identically. 
    554544      !! 
    555545      !! ** Method  :   Note this routine can be used to switch on/off some 
    556       !!                types of output for selected areas but any output types 
    557       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    558       !!                should be protected from selective switching by the 
    559       !!                for_all argument 
    560       !!---------------------------------------------------------------------- 
    561       LOGICAL :: setto, for_all 
    562       TYPE(sn_ctl) :: sn_cfctl 
    563       !!---------------------------------------------------------------------- 
    564       IF( for_all ) THEN 
    565          sn_cfctl%l_runstat = setto 
    566          sn_cfctl%l_trcstat = setto 
    567       ENDIF 
     546      !!                types of output for selected areas. 
     547      !!---------------------------------------------------------------------- 
     548      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     549      LOGICAL     , INTENT(in   ) :: setto 
     550      !!---------------------------------------------------------------------- 
     551      sn_cfctl%l_runstat = setto 
     552      sn_cfctl%l_trcstat = setto 
    568553      sn_cfctl%l_oceout  = setto 
    569554      sn_cfctl%l_layout  = setto 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/sbcssm.F90

    r12377 r13159  
    2626   USE lib_mpp        ! distributed memory computing library 
    2727   USE prtctl         ! print control 
    28    USE fldread        ! read input fields  
     28   USE fldread        ! read input fields 
    2929   USE timing         ! Timing 
    3030 
     
    3838   LOGICAL            ::   ln_3d_uve     ! specify whether input velocity data is 3D 
    3939   LOGICAL            ::   ln_read_frq   ! specify whether we must read frq or not 
    40     
     40 
    4141   LOGICAL            ::   l_sasread     ! Ice intilisation: =T read a file ; =F anaytical initilaistion 
    4242   LOGICAL            ::   l_initdone = .false. 
     
    6969      !!               for an off-line simulation using surface processes only 
    7070      !! 
    71       !! ** Method : calculates the position of data  
     71      !! ** Method : calculates the position of data 
    7272      !!             - interpolates data if needed 
    7373      !!---------------------------------------------------------------------- 
    7474      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7575      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    76                           ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
     76      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    7777      ! 
    7878      INTEGER  ::   ji, jj     ! dummy loop indices 
     
    8282      ! 
    8383      IF( ln_timing )   CALL timing_start( 'sbc_ssm') 
    84       
     84 
    8585      IF ( l_sasread ) THEN 
    8686         IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==! 
    8787         IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
    88          !  
     88         ! 
    8989         IF( ln_3d_uve ) THEN 
    9090            IF( .NOT. ln_linssh ) THEN 
    91                e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor  
     91               e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    9292            ELSE 
    9393               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    9494            ENDIF 
    9595            ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    96             ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     96            ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    9797         ELSE 
    9898            IF( .NOT. ln_linssh ) THEN 
    99                e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor  
     99               e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    100100            ELSE 
    101101               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    102102            ENDIF 
    103103            ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    104             ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     104            ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    105105         ENDIF 
    106106         ! 
     
    123123         ssh  (:,:,Kmm) = 0._wp                              !              - - 
    124124      ENDIF 
    125        
     125 
    126126      IF ( nn_ice == 1 ) THEN 
    127127         ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) 
     
    132132      uu (:,:,1,Kbb) = ssu_m(:,:) 
    133133      vv (:,:,1,Kbb) = ssv_m(:,:) 
    134   
     134 
    135135      IF(sn_cfctl%l_prtctl) THEN            ! print control 
    136136         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask   ) 
     
    162162      !!                  ***  ROUTINE sbc_ssm_init  *** 
    163163      !! 
    164       !! ** Purpose :   Initialisation of sea surface mean data      
    165       !!---------------------------------------------------------------------- 
    166       INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices  
    167                           ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
     164      !! ** Purpose :   Initialisation of sea surface mean data 
     165      !!---------------------------------------------------------------------- 
     166      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     167      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    168168      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
    169169      INTEGER  :: ifpr                               ! dummy loop indice 
     
    195195902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' ) 
    196196      IF(lwm) WRITE ( numond, namsbc_sas ) 
    197       !            
     197      ! 
    198198      IF(lwp) THEN                              ! Control print 
    199199         WRITE(numout,*) '   Namelist namsbc_sas' 
    200          WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread  
     200         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread 
    201201         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve 
    202202         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq 
     
    226226         ln_closea = .false. 
    227227      ENDIF 
    228        
    229       !                   
     228 
     229      ! 
    230230      IF( l_sasread ) THEN                       ! store namelist information in an array 
    231          !  
     231         ! 
    232232         !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 
    233233         !! when we have other 3d arrays that we need to read in 
     
    275275         ENDIF 
    276276         ! 
    277          ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.  
     277         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false. 
    278278         IF( nfld_3d > 0 ) THEN 
    279279            ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure 
     
    282282            ENDIF 
    283283            DO ifpr = 1, nfld_3d 
    284                                             ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
     284               ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
    285285               IF( slf_3d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 ) 
    286286               IF( ierr0 + ierr1 > 0 ) THEN 
     
    298298            ENDIF 
    299299            DO ifpr = 1, nfld_2d 
    300                                             ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
     300               ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
    301301               IF( slf_2d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 ) 
    302302               IF( ierr0 + ierr1 > 0 ) THEN 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/step.F90

    r12377 r13159  
    7474      !!              -2- Outputs and diagnostics 
    7575      !!---------------------------------------------------------------------- 
    76       INTEGER ::   indic    ! error indicator if < 0 
    77       !! --------------------------------------------------------------------- 
    7876 
    7977#if defined key_agrif 
     78      IF( nstop > 0 ) RETURN   ! avoid to go further if an error was detected during previous time step (child grid) 
    8079      kstp = nit000 + Agrif_Nb_Step() 
    8180      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    82       IF ( lk_agrif_debug ) THEN 
    83          IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
    84          IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 
     81      IF( lk_agrif_debug ) THEN 
     82         IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---' 
     83         IF(lwp)   WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint() 
    8584      ENDIF 
    86  
    87       IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
    88  
     85      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE. 
    8986# if defined key_iomput 
    9087      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    9188# endif    
    9289#endif    
    93                              indic = 0                    ! although indic is not changed in stp_ctl 
    94                                                           ! need to keep the same interface  
    9590      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    9691      IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init) 
     
    109104#if defined key_agrif 
    110105      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    111       ! AGRIF 
     106      ! AGRIF recursive integration 
    112107      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    113                              CALL Agrif_Integrate_ChildGrids( stp )   
     108                             CALL Agrif_Integrate_ChildGrids( stp ) 
     109                              
     110#endif                              
     111      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     112      ! Control 
     113      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     114                             CALL stp_ctl( kstp, Nnn ) 
    114115 
    115       IF( Agrif_NbStepint() == 0 ) THEN               ! AGRIF Update from zoom N to zoom 1 then to Parent  
     116#if defined key_agrif 
     117      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     118      ! AGRIF update 
     119      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     120      IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN                       ! AGRIF Update from zoom N to zoom 1 then to Parent  
    116121#if defined key_si3 
    117122                             CALL Agrif_Update_ice( )   ! update sea-ice 
    118123#endif 
    119124      ENDIF 
     125 
    120126#endif 
    121                               
    122127      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    123       ! Control 
    124       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    125                              CALL stp_ctl( kstp, indic ) 
    126       IF( indic < 0  )  THEN 
    127                              CALL ctl_stop( 'step: indic < 0' ) 
    128                              CALL dia_wri_state( 'output.abort', Nnn ) 
    129       ENDIF 
    130       IF( kstp == nit000   ) CALL iom_close( numror )           ! close input  ocean restart file 
     128      ! File manipulation at the end of the first time step 
     129      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
     130      IF( kstp == nit000   ) CALL iom_close( numror )                          ! close input  ocean restart file 
    131131       
    132132      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    133133      ! Coupled mode 
    134134      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    135       IF( lk_oasis    )  CALL sbc_cpl_snd( kstp, Nbb, Nnn )     ! coupled mode : field exchanges if OASIS-coupled ice 
     135      IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp, Nbb, Nnn )       ! coupled mode : field exchanges if OASIS-coupled ice 
    136136 
    137137#if defined key_iomput 
     
    144144         lrst_oce = .FALSE. 
    145145      ENDIF 
    146       IF( kstp == nitend .OR. indic < 0 ) THEN 
    147                              CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
     146      IF( kstp == nitend .OR. nstop > 0 ) THEN 
     147         CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
    148148      ENDIF 
    149149#endif 
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/stpctl.F90

    r12377 r13159  
    2121   USE ice      , ONLY : vt_i, u_ice, tm_i 
    2222   ! 
     23   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    2324   USE in_out_manager  ! I/O manager 
    2425   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2526   USE lib_mpp         ! distributed memory computing 
    26  
     27   ! 
    2728   USE netcdf          ! NetCDF library 
    2829   IMPLICIT NONE 
     
    3132   PUBLIC stp_ctl           ! routine called by step.F90 
    3233 
    33    INTEGER  ::   idrun, idtime, idssh, idu, ids, istatus 
    34    LOGICAL  ::   lsomeoce 
     34   INTEGER                ::   nrunid   ! netcdf file id 
     35   INTEGER, DIMENSION(3)  ::   nvarid   ! netcdf variable id 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
     
    3839   !! Software governed by the CeCILL license (see ./LICENSE) 
    3940   !!---------------------------------------------------------------------- 
    40  
    4141CONTAINS 
    4242 
    43    SUBROUTINE stp_ctl( kt, kindic ) 
     43   SUBROUTINE stp_ctl( kt, Kmm ) 
    4444      !!---------------------------------------------------------------------- 
    4545      !!                    ***  ROUTINE stp_ctl  *** 
     
    4949      !! ** Method  : - Save the time step in numstp 
    5050      !!              - Print it each 50 time steps 
     51      !!              - Stop the run IF problem encountered by setting nstop > 0 
     52      !!                Problems checked: ice thickness maximum > 100 m 
     53      !!                                  ice velocity  maximum > 10 m/s  
     54      !!                                  min ice temperature   < -100 degC 
    5155      !! 
    5256      !! ** Actions :   "time.step" file = last ocean time-step 
    5357      !!                "run.stat"  file = run statistics 
    54       !!                 
    55       !!---------------------------------------------------------------------- 
    56       INTEGER, INTENT( in    ) ::   kt       ! ocean time-step index 
    57       INTEGER, INTENT( inout ) ::   kindic   ! indicator of solver convergence 
    58       !! 
    59       REAL(wp), DIMENSION(3) ::   zmax 
    60       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    61       CHARACTER(len=20) :: clname 
    62       !!---------------------------------------------------------------------- 
    63       ! 
    64       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    65       ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
    66       ll_wrtruns = ll_colruns .AND. lwm 
    67       IF( kt == nit000 .AND. lwp ) THEN 
    68          WRITE(numout,*) 
    69          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    70          WRITE(numout,*) '~~~~~~~' 
    71          !                                ! open time.step file 
    72          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    73          !                                ! open run.stat file(s) at start whatever 
    74          !                                ! the value of sn_cfctl%ptimincr 
    75          IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
     58      !!                 nstop indicator sheared among all local domain 
     59      !!---------------------------------------------------------------------- 
     60      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
     61      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     62      !! 
     63      INTEGER                         ::   ji                                    ! dummy loop indices 
     64      INTEGER                         ::   idtime, istatus 
     65      INTEGER , DIMENSION(4)          ::   iareasum, iareamin, iareamax 
     66      INTEGER , DIMENSION(3,3)        ::   iloc                                  ! min/max loc indices 
     67      REAL(wp)                        ::   zzz                                   ! local real  
     68      REAL(wp), DIMENSION(4)          ::   zmax, zmaxlocal 
     69      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns 
     70      LOGICAL, DIMENSION(jpi,jpj)     ::   llmsk 
     71      CHARACTER(len=20)               ::   clname 
     72      !!---------------------------------------------------------------------- 
     73      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     74      ! 
     75      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     76      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     77      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     78      ! 
     79      IF( kt == nit000 ) THEN 
     80         ! 
     81         IF( lwp ) THEN 
     82            WRITE(numout,*) 
     83            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     84            WRITE(numout,*) '~~~~~~~' 
     85         ENDIF 
     86         !                                ! open time.step    ascii file, done only by 1st subdomain 
     87         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     88         ! 
     89         IF( ll_wrtruns ) THEN 
     90            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    7691            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     92            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    7793            clname = 'run.stat.nc' 
    7894            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    79             istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 
    80             istatus = NF90_DEF_DIM( idrun, 'time'     , NF90_UNLIMITED, idtime ) 
    81             istatus = NF90_DEF_VAR( idrun, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), idssh ) 
    82             istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 
    83             istatus = NF90_DEF_VAR( idrun, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), ids ) 
    84             istatus = NF90_ENDDEF(idrun) 
    85          ENDIF 
    86       ENDIF 
    87       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    88       ! 
    89       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     95            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     96            istatus = NF90_DEF_DIM( nrunid, 'time'     , NF90_UNLIMITED, idtime ) 
     97            istatus = NF90_DEF_VAR( nrunid, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     98            istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     99            istatus = NF90_DEF_VAR( nrunid, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), nvarid(3) ) 
     100            istatus = NF90_ENDDEF(nrunid) 
     101         ENDIF 
     102         !     
     103      ENDIF 
     104      ! 
     105      !                                   !==              write current time step              ==! 
     106      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     107      IF( lwm .AND. ll_wrtstp ) THEN 
    90108         WRITE ( numstp, '(1x, i8)' )   kt 
    91109         REWIND( numstp ) 
    92110      ENDIF 
    93       !                                   !==  test of extrema  ==! 
     111      !                                   !==            test of local extrema           ==! 
     112      !                                   !==  done by all processes at every time step  ==! 
     113      llmsk(:,:) = tmask(:,:,1) == 1._wp 
     114      IF( COUNT( llmsk(:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     115         zmax(1) = MAXVAL(      vt_i (:,:)            , mask = llmsk )   ! max ice thickness 
     116         zmax(2) = MAXVAL( ABS( u_ice(:,:) )          , mask = llmsk )   ! max ice velocity (zonal only) 
     117         zmax(3) = MAXVAL(     -tm_i (:,:) + 273.15_wp, mask = llmsk )   ! min ice temperature 
     118      ELSE 
     119         IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
     120            zmax(1:3) = -HUGE(1._wp) 
     121         ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 
     122            zmax(1:3) = 0._wp 
     123         ENDIF 
     124      ENDIF 
     125      zmax(4) = REAL( nstop, wp )                                     ! stop indicator 
     126      !                                   !==               get global extrema             ==! 
     127      !                                   !==  done by all processes if writting run.stat  ==! 
    94128      IF( ll_colruns ) THEN 
    95          zmax(1) = MAXVAL(      vt_i (:,:) )                                           ! max ice thickness 
    96          zmax(2) = MAXVAL( ABS( u_ice(:,:) ) )                                         ! max ice velocity (zonal only) 
    97          zmax(3) = MAXVAL(     -tm_i (:,:)+273.15_wp , mask = ssmask(:,:) == 1._wp )   ! min ice temperature 
    98          CALL mpp_max( "stpctl", zmax )                                   ! max over the global domain 
     129         zmaxlocal(:) = zmax(:) 
     130         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
     131         nstop = NINT( zmax(4) )                 ! update nstop indicator (now sheared among all local domains) 
     132      ENDIF 
     133      !                                   !==              write "run.stat" files              ==! 
     134      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     135      IF( ll_wrtruns ) THEN 
     136         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3) 
     137         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     138         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
     139         istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 
     140         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    99141      END IF 
    100       !                                            !==  run statistics  ==!   ("run.stat" file) 
    101       IF( ll_wrtruns ) THEN 
    102          WRITE(numrun,9500) kt, zmax(1), zmax(2), - zmax(3) 
    103          istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    104          istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    105          istatus = NF90_PUT_VAR( idrun,   ids, (/-zmax(3)/), (/kt/), (/1/) ) 
    106          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    107          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
    108       END IF 
     142      !                                   !==               error handling               ==! 
     143      !                                   !==  done by all processes at every time step  ==! 
     144      ! 
     145      IF(   zmax(1) >  100._wp .OR.   &                   ! too large ice thickness maximum ( > 100 m) 
     146         &  zmax(2) >   10._wp .OR.   &                   ! too large ice velocity ( > 10 m/s) 
     147         &  zmax(3) >  101._wp .OR.   &                   ! too cold ice temperature ( < -100 degC) 
     148         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
     149         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     150         ! 
     151         iloc(:,:) = 0 
     152         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     153            ! first: close the netcdf file, so we can read it 
     154            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     155            ! get global loc on the min/max 
     156            CALL mpp_maxloc( 'stpctl',      vt_i(:,:)            , tmask(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     157            CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) )          , tmask(:,:,1), zzz, iloc(1:2,2) ) 
     158            CALL mpp_minloc( 'stpctl',      tm_i(:,:) - 273.15_wp, tmask(:,:,1), zzz, iloc(1:2,3) ) 
     159            ! find which subdomain has the max. 
     160            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     161            DO ji = 1, 4 
     162               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     163                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     164               ENDIF 
     165            END DO 
     166            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     167            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     168            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     169         ELSE                    ! find local min and max locations: 
     170            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     171            iloc(1:2,1) = MAXLOC(       vt_i(:,:)            , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     172            iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) )          , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     173            iloc(1:2,3) = MINLOC(       tm_i(:,:) - 273.15_wp, mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     174            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     175         ENDIF 
     176         ! 
     177         WRITE(ctmp1,*) ' stp_ctl: ice_thick > 100 m or |ice_vel| > 10 m/s or ice_temp < -100 degC or NaN encounter in the tests' 
     178         CALL wrt_line( ctmp2, kt, 'ice_thick max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     179         CALL wrt_line( ctmp3, kt, '|ice_vel| max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     180         CALL wrt_line( ctmp4, kt, 'ice_temp  min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     181         IF( Agrif_Root() ) THEN 
     182            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
     183         ELSE 
     184            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     185         ENDIF 
     186         ! 
     187         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
     188         ! 
     189         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     190            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     191            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     192            ENDIF 
     193         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     194            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     195         ENDIF 
     196         ! 
     197      ENDIF 
     198      ! 
     199      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     200         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     201         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
     202      ENDIF 
    109203      ! 
    1102049500  FORMAT(' it :', i8, '    vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16) 
    111205      ! 
    112206   END SUBROUTINE stp_ctl 
     207 
     208 
     209   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     210      !!---------------------------------------------------------------------- 
     211      !!                     ***  ROUTINE wrt_line  *** 
     212      !! 
     213      !! ** Purpose :   write information line 
     214      !! 
     215      !!---------------------------------------------------------------------- 
     216      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     217      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     218      REAL(wp),              INTENT(in   ) ::   pval 
     219      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     220      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     221      ! 
     222      CHARACTER(len=80) ::   clsuff 
     223      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     224      CHARACTER(len=9 ) ::   cli, clj, clk 
     225      CHARACTER(len=1 ) ::   clfmt 
     226      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     227      INTEGER           ::   ifmtk 
     228      !!---------------------------------------------------------------------- 
     229      WRITE(clkt , '(i9)') kt 
     230       
     231      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     232      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     233      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     234      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     235      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     236                                   WRITE(clmax, cl4) kmax-1 
     237      ! 
     238      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     239      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     240      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     241      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     242      ! 
     243      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     244      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     245      ENDIF 
     246      IF(kloc(3) == 0) THEN 
     247         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     248         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     249         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     250      ELSE 
     251         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     252         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     253         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     254         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     255      ENDIF 
     256      ! 
     2579100  FORMAT('MPI rank ', a) 
     2589200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     2599300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     2609400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     261      ! 
     262   END SUBROUTINE wrt_line 
     263 
    113264 
    114265   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.