Skip to content
Snippets Groups Projects
modeln.f90 92.7 KiB
Newer Older
  • Learn to ignore specific revisions
  • VIE Benoit's avatar
    VIE Benoit committed
          XACPRG = XACPRG + XINPRG * XTSTEP
          IF (CCLOUD == 'ICE4' .OR. (CCLOUD == 'LIMA' .AND. NMOM_H.GE.1)) XACPRH = XACPRH + XINPRH * XTSTEP          
        END IF
    !
    ! Lessivage des CCN et IFN nucléables par Slinn
    !
        IF (LSCAV .AND. (CCLOUD == 'LIMA')) THEN
          CALL LIMA_PRECIP_SCAVENGING(CCLOUD, ILUOUT, KTCOUNT,XTSTEP,XRT(:,:,:,3), &
                                  XRHODREF, XRHODJ, XZZ, XPABST, XTHT,             &
                                  XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END),           &
                                  XRSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), XINPAP   )
    !
          XACPAP(:,:) = XACPAP(:,:) + XINPAP(:,:) * XTSTEP
        END IF
      END IF
    !
    ! It is necessary that SV_C2R2 and SV_C1R3 are contiguous in the preceeding CALL
    !
    END IF
    !
    CALL SECOND_MNH2(ZTIME2)
    !
    XT_CLOUD = XT_CLOUD + ZTIME2 - ZTIME1 &
               - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
    !
    !-------------------------------------------------------------------------------
    !
    !*       21.    CLOUD ELECTRIFICATION AND LIGHTNING FLASHES
    !               -------------------------------------------
    !
    ZTIME1 = ZTIME2
    XTIME_BU_PROCESS = 0.
    XTIME_LES_BU_PROCESS = 0.
    !
    IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
      XWT_ACT_NUC(:,:,:) = 0.
    !
      XRTHS_CLD = XRTHS
      XRRS_CLD  = XRRS
      XRSVS_CLD = XRSVS
      IF (CSURF=='EXTE') THEN
        ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
        ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
        ZSEA(:,:) = 0.
        ZTOWN(:,:)= 0.
        CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
        CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD,                     &
                              NRR, NSPLITR, IMI, KTCOUNT, OEXIT,             &
                              CLBCX, CLBCY, CRAD, CTURBDIM,                  &
                              LSUBG_COND, LSIGMAS,VSIGQSAT,CSUBG_AUCV,       &
                              XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF,        &
                              ZPABST, XTHT, XRTHS, XWT,  XRT, XRRS,          &
                              XSVT, XRSVS, XCIT,                             &
                              XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
                              XRI_MF, LSEDIC, LWARM,                         &
                              XINPRC, XINPRR, XINPRR3D, XEVAP3D,             &
                              XINPRS, XINPRG, XINPRH,                        &
                              ZSEA, ZTOWN                                    )
        DEALLOCATE(ZTOWN)
        DEALLOCATE(ZSEA)
      ELSE
        CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD,                     &
                              NRR, NSPLITR, IMI, KTCOUNT, OEXIT,             &
                              CLBCX, CLBCY, CRAD, CTURBDIM,                  &
                              LSUBG_COND, LSIGMAS,VSIGQSAT, CSUBG_AUCV,      &
                              XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF,        &
                              ZPABST, XTHT, XRTHS, XWT,                      &
                              XRT, XRRS, XSVT, XRSVS, XCIT,                  &
                              XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
                              XRI_MF, LSEDIC, LWARM,                         &
                              XINPRC, XINPRR, XINPRR3D, XEVAP3D,             &
                              XINPRS, XINPRG, XINPRH                         )
      END IF
      XRTHS_CLD = XRTHS - XRTHS_CLD
      XRRS_CLD  = XRRS  - XRRS_CLD
      XRSVS_CLD = XRSVS - XRSVS_CLD
    !
      XACPRR = XACPRR + XINPRR * XTSTEP
      IF ((CCLOUD(1:3) == 'ICE' .AND. LSEDIC)) & 
           XACPRC = XACPRC + XINPRC * XTSTEP
      IF (CCLOUD(1:3) == 'ICE') THEN
        XACPRS = XACPRS + XINPRS * XTSTEP
        XACPRG = XACPRG + XINPRG * XTSTEP
        IF (CCLOUD == 'ICE4') XACPRH = XACPRH + XINPRH * XTSTEP          
      END IF
    END IF
    !
    CALL SECOND_MNH2(ZTIME2)
    !
    XT_ELEC = XT_ELEC + ZTIME2 - ZTIME1 &
               - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
    !
    !-------------------------------------------------------------------------------
    !
    !*       21.    L.E.S. COMPUTATIONS
    !               -------------------
    !
    ZTIME1 = ZTIME2
    !
    CALL LES_n
    !
    CALL SECOND_MNH2(ZTIME2)
    !
    XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
    !
    !-------------------------------------------------------------------------------
    !
    !*       21. bis    MEAN_UM
    !               --------------------
    !
    IF (LMEAN_FIELD) THEN
       CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1))
    END IF
    !
    !-------------------------------------------------------------------------------
    !
    !*       22.    UPDATE HALO OF EACH SUBDOMAINS FOR TIME T+DT
    !               --------------------------------------------
    !
    ZTIME1 = ZTIME2
    !
    CALL EXCHANGE (XTSTEP,NRR,NSV,XRHODJ,TFIELDS_ll,     &
                   XRUS, XRVS,XRWS,XRTHS,XRRS,XRTKES,XRSVS)
    !
    CALL SECOND_MNH2(ZTIME2)
    !
    XT_HALO = XT_HALO + ZTIME2 - ZTIME1
    !
    !-------------------------------------------------------------------------------
    !
    !*       23.    TEMPORAL SWAPPING
    !               -----------------
    !
    ZTIME1 = ZTIME2
    XTIME_BU_PROCESS = 0.
    !
    CALL ENDSTEP  ( XTSTEP,NRR,NSV,KTCOUNT,IMI,               &
                    CUVW_ADV_SCHEME,CTEMP_SCHEME,XRHODJ,      &
                    XRUS,XRVS,XRWS,XDRYMASSS,                 &
                    XRTHS,XRRS,XRTKES,XRSVS,                  &
                    XLSUS,XLSVS,XLSWS,                        &
                    XLSTHS,XLSRVS,XLSZWSS,                    &
                    XLBXUS,XLBXVS,XLBXWS,                     &
                    XLBXTHS,XLBXRS,XLBXTKES,XLBXSVS,          &
                    XLBYUS,XLBYVS,XLBYWS,                     &
                    XLBYTHS,XLBYRS,XLBYTKES,XLBYSVS,          &
                    XUM,XVM,XWM,XZWS,                         &
                    XUT,XVT,XWT,XPABST,XDRYMASST,             &
                    XTHT, XRT, XTHM, XRCM, XPABSM,XTKET, XSVT,&
                    XLSUM,XLSVM,XLSWM,                        &
                    XLSTHM,XLSRVM,XLSZWSM,                    &
                    XLBXUM,XLBXVM,XLBXWM,                     &
                    XLBXTHM,XLBXRM,XLBXTKEM,XLBXSVM,          &
                    XLBYUM,XLBYVM,XLBYWM,                     &
                    XLBYTHM,XLBYRM,XLBYTKEM,XLBYSVM           )
    !
    CALL SECOND_MNH2(ZTIME2)
    !
    XT_STEP_SWA = XT_STEP_SWA + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
    !
    !-------------------------------------------------------------------------------
    !
    !*       24.1    BALLOON and AIRCRAFT
    !               --------------------
    !
    ZTIME1 = ZTIME2
    !
    IF (LFLYER) THEN
      IF (CSURF=='EXTE') THEN
        ALLOCATE(ZSEA(IIU,IJU))
        ZSEA(:,:) = 0.
        CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
    
        CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI,                   &
                               XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
                               XRHODREF, XCIT, PSEA = ZSEA(:,:)                       )
    
    VIE Benoit's avatar
    VIE Benoit committed
        DEALLOCATE(ZSEA)
      ELSE
    
        CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI,                   &
                               XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
                               XRHODREF, XCIT                                         )
    
    VIE Benoit's avatar
    VIE Benoit committed
      END IF
    END IF
    
    !-------------------------------------------------------------------------------
    !
    !*       24.2    STATION (observation diagnostic)
    !               --------------------------------
    !
    
    IF ( LSTATION ) &
      CALL STATION_n( XZZ, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
    
    VIE Benoit's avatar
    VIE Benoit committed
    !
    !---------------------------------------------------------
    !
    !*       24.3    PROFILER (observation diagnostic)
    !               ---------------------------------
    !
    IF (LPROFILER)  THEN
      IF (CSURF=='EXTE') THEN
        ALLOCATE(ZSEA(IIU,IJU))
        ZSEA(:,:) = 0.
        CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
    
        CALL PROFILER_n( XZZ, XRHODREF,                             &
                         XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET,     &
                         XTSRAD, XPABST, XAER, XCIT, PSEA=ZSEA(:,:) )
    
    VIE Benoit's avatar
    VIE Benoit committed
        DEALLOCATE(ZSEA)
      ELSE
    
        CALL PROFILER_n( XZZ, XRHODREF,                         &
                         XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
                         XTSRAD, XPABST, XAER, XCIT             )
    
    VIE Benoit's avatar
    VIE Benoit committed
      END IF
    END IF
    !
    IF (ALLOCATED(ZSEA)) DEALLOCATE (ZSEA)
    !
    CALL SECOND_MNH2(ZTIME2)
    !
    XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1
    !
    !-------------------------------------------------------------------------------
    !
    !*       24.4   deallocation of observation diagnostics
    !               ---------------------------------------
    !
    CALL END_DIAG_IN_RUN
    !
    !-------------------------------------------------------------------------------
    !
    !
    !*       25.    STORAGE OF BUDGET FIELDS
    !               ------------------------
    !
    ZTIME1 = ZTIME2
    !
    IF ( .NOT. LIO_NO_WRITE ) THEN
      IF (NBUMOD==IMI .AND. CBUTYPE/='NONE') THEN
        CALL ENDSTEP_BUDGET(TDIAFILE,KTCOUNT,TDTCUR,XTSTEP,NSV)
      END IF
    END IF
    !
    CALL SECOND_MNH2(ZTIME2)
    !
    XT_STEP_BUD = XT_STEP_BUD + ZTIME2 - ZTIME1 + XTIME_BU
    !
    !-------------------------------------------------------------------------------
    !
    !*       27.    CURRENT TIME REFRESH
    !               --------------------
    !
    TDTCUR%xtime=TDTCUR%xtime + XTSTEP
    CALL DATETIME_CORRECTDATE(TDTCUR)
    !
    !-------------------------------------------------------------------------------
    !
    !*       28.    CPU ANALYSIS
    !               ------------
    !
    CALL SECOND_MNH2(ZTIME2)
    XT_START=XT_START+ZTIME2-ZEND
    !
    !
    IF ( KTCOUNT == NSTOP .AND. IMI==1) THEN
      OEXIT=.TRUE.
    END IF
    !
    IF (OEXIT) THEN
    !
      IF ( .NOT. LIO_NO_WRITE ) THEN
        IF (LSERIES) CALL WRITE_SERIES_n(TDIAFILE)
        CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE)
        CALL WRITE_STATION_n(TDIAFILE)
        CALL WRITE_PROFILER_n(TDIAFILE)
        call Write_les_n( tdiafile )
    #ifdef MNH_IOLFI
        CALL MENU_DIACHRO(TDIAFILE,'END')
    #endif
        CALL IO_File_close(TDIAFILE)
    
        ! Free memory of flyer that is not present on the master process of the file (was allocated in WRITE_AIRCRAFT_BALLOON)
        CALL AIRCRAFT_BALLOON_FREE_NONLOCAL( TDIAFILE )
    
    VIE Benoit's avatar
    VIE Benoit committed
      END IF
      !
      CALL IO_File_close(TINIFILE)
      IF (CSURF=="EXTE") CALL IO_File_close(TINIFILEPGD)
    !
    !*       28.1   print statistics!
    !
      ! Set File Timing OUTPUT
      !
      CALL SET_ILUOUT_TIMING(TLUOUT)
      !
      ! Compute global time
      !
      CALL TIME_STAT_ll(XT_START,ZTOT)
      !
      CALL TIME_HEADER_ll(IMI)
      !
      CALL TIME_STAT_ll(XT_1WAY,ZTOT,       ' ONE WAY','=')
      CALL TIME_STAT_ll(XT_BOUND,ZTOT,      ' BOUNDARIES','=')
      CALL TIME_STAT_ll(XT_STORE,ZTOT,      ' STORE-FIELDS','=')
        CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_SEND,ZTOT,    '   W3D_SEND ','-')
        CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_RECV,ZTOT,    '   W3D_RECV ','-')
        CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WRIT,ZTOT,    '   W3D_WRIT ','-')
        CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WAIT,ZTOT,    '   W3D_WAIT ','-')
        CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_ALL ,ZTOT,    '   W3D_ALL ','-')
        CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_GATH,ZTOT,    '   W2D_GATH ','-')
        CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_WRIT,ZTOT,    '   W2D_WRIT ','-')
        CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_ALL ,ZTOT,    '   W2D_ALL ','-')
      CALL TIME_STAT_ll(XT_GUESS,ZTOT,      ' INITIAL_GUESS','=')
      CALL TIME_STAT_ll(XT_2WAY,ZTOT,       ' TWO WAY','=')
      CALL TIME_STAT_ll(XT_ADV,ZTOT,        ' ADVECTION MET','=')
      CALL TIME_STAT_ll(XT_ADVUVW,ZTOT,     ' ADVECTION UVW','=')
      CALL TIME_STAT_ll(XT_GRAV,ZTOT,       ' GRAVITY','=')
      CALL TIME_STAT_ll(XT_FORCING,ZTOT,    ' FORCING','=')
      CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,   ' IBM','=')  
      CALL TIME_STAT_ll(XT_NUDGING,ZTOT,    ' NUDGING','=')
      CALL TIME_STAT_ll(XT_SOURCES,ZTOT,    ' DYN_SOURCES','=')
      CALL TIME_STAT_ll(XT_DIFF,ZTOT,       ' NUM_DIFF','=')
      CALL TIME_STAT_ll(XT_RELAX,ZTOT,      ' RELAXATION','=')
      !
      CALL  TIMING_LEGEND() 
      !
      CALL TIME_STAT_ll(XT_PARAM,ZTOT,      ' PHYS_PARAM','=')
        CALL TIME_STAT_ll(XT_RAD,ZTOT,      '   RAD       = '//CRAD  ,'-')
        CALL TIME_STAT_ll(XT_SHADOWS,ZTOT,  '   SHADOWS'             ,'-')
        CALL TIME_STAT_ll(XT_DCONV,ZTOT,    '   DEEP CONV = '//CDCONV,'-')
        CALL TIME_STAT_ll(XT_GROUND,ZTOT,   '   GROUND'              ,'-')
        ! Blaze perf
        IF (LBLAZE) THEN
          CALL TIME_STAT_ll(XFIREPERF,ZBLAZETOT)
          CALL TIME_STAT_ll(XFIREPERF,ZTOT,           '     BLAZE'          ,'~')
          CALL TIME_STAT_ll(XGRADPERF,ZBLAZETOT,      '       GRAD(PHI)'    ,' ')
          CALL TIME_STAT_ll(XROSWINDPERF,ZBLAZETOT,   '       ROS & WIND'   ,' ')
          CALL TIME_STAT_ll(XPROPAGPERF,ZBLAZETOT,    '       PROPAGATION'  ,' ')
          CALL TIME_STAT_ll(XFLUXPERF,ZBLAZETOT,      '       HEAT FLUXES'  ,' ')
        END IF
        CALL TIME_STAT_ll(XT_TURB,ZTOT,     '   TURB      = '//CTURB ,'-')
        CALL TIME_STAT_ll(XT_MAFL,ZTOT,     '   MAFL      = '//CSCONV,'-')
        CALL TIME_STAT_ll(XT_CHEM,ZTOT,     '   CHIMIE'              ,'-')
        CALL TIME_STAT_ll(XT_EOL,ZTOT,      '   WIND TURBINE'        ,'-')
      CALL  TIMING_LEGEND()
      CALL TIME_STAT_ll(XT_COUPL,ZTOT,      ' SET_COUPLING','=')
      CALL TIME_STAT_ll(XT_RAD_BOUND,ZTOT,  ' RAD_BOUND','=')
      !
      CALL  TIMING_LEGEND()
      ! 
      CALL TIME_STAT_ll(XT_PRESS,ZTOT,      ' PRESSURE ','=','F')
      !JUAN Z_SPLITTING
        CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SX_YP2_ZP1,ZTOT,          '   REMAP       B=>FFTXZ'  ,'-','F')
        CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1,ZTOT, '   REMAP   FFTXZ=>FFTYZ'  ,'-','F')
        CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_B,ZTOT,          '   REMAP   FTTYZ=>B'      ,'-','F')
        CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z,ZTOT, '   REMAP   FFTYZ=>SUBZ'   ,'-','F')
        CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SXP2_Y_ZP1,ZTOT,          '   REMAP       B=>FFTYZ-1','-','F')
        CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1,ZTOT, '   REMAP    SUBZ=>FFTYZ-1','-','F')
        CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1,ZTOT, '   REMAP FFTYZ-1=>FFTXZ-1','-','F')
        CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_B,ZTOT,          '   REMAP FFTXZ-1=>B     ' ,'-','F')
      ! JUAN P1/P2
      CALL TIME_STAT_ll(XT_CLOUD,ZTOT,      ' RESOLVED_CLOUD','=')
      CALL TIME_STAT_ll(XT_ELEC,ZTOT,      ' RESOLVED_ELEC','=')
      CALL TIME_STAT_ll(XT_HALO,ZTOT,       ' EXCHANGE_HALO','=')
      CALL TIME_STAT_ll(XT_STEP_SWA,ZTOT,   ' ENDSTEP','=')
      CALL TIME_STAT_ll(XT_STEP_BUD,ZTOT,   ' BUDGETS','=')
      CALL TIME_STAT_ll(XT_SPECTRA,ZTOT,    ' LES','=')
      CALL TIME_STAT_ll(XT_STEP_MISC,ZTOT,  ' MISCELLANEOUS','=')
      IF (LIBM) CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,' IBM FORCING','=') 
      !
      ! sum of call subroutine
      !
      ZALL   = XT_1WAY + XT_BOUND   + XT_STORE   + XT_GUESS    +  XT_2WAY   + &
               XT_ADV  + XT_FORCING + XT_NUDGING + XT_SOURCES  +  XT_DIFF   + &
               XT_ADVUVW  + XT_GRAV + XT_IBM_FORC                           + &
               XT_RELAX+ XT_PARAM   + XT_COUPL   + XT_RAD_BOUND+XT_PRESS    + &
               XT_CLOUD+ XT_ELEC    + XT_HALO    + XT_SPECTRA + XT_STEP_SWA + &
               XT_STEP_MISC+ XT_STEP_BUD
      CALL TIME_STAT_ll(ZALL,ZTOT,          ' SUM(CALL)','=')
      CALL  TIMING_SEPARATOR('=')
      !
      ! Gobale Stat
      !
      WRITE(ILUOUT,FMT=*)
      WRITE(ILUOUT,FMT=*)
      CALL  TIMING_LEGEND() 
      !
      ! MODELN all included
      !
      CALL  TIMING_SEPARATOR('+')
      CALL  TIMING_SEPARATOR('+')  
      WRITE(YMI,FMT="(I0)") IMI
      CALL TIME_STAT_ll(XT_START,ZTOT,      ' MODEL'//YMI,'+')
      CALL  TIMING_SEPARATOR('+')
      CALL  TIMING_SEPARATOR('+')
      CALL  TIMING_SEPARATOR('+')
      !
      ! Timing/ Steps
      !
      ZTIME_STEP     =  XT_START / REAL(KTCOUNT)
      WRITE(YTCOUNT,FMT="(I0)") KTCOUNT
      CALL TIME_STAT_ll(ZTIME_STEP,ZTOT,     ' SECOND/STEP='//YTCOUNT,'=')
      !
      ! Timing/Step/Points
      !
      IPOINTS = NIMAX_ll*NJMAX_ll*NKMAX
      WRITE(YPOINTS,FMT="(I0)") IPOINTS
      ZTIME_STEP_PTS =  ZTIME_STEP / REAL(IPOINTS) * 1e6
      CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT)
      CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT,  ' MICROSEC/STP/PT='//YPOINTS,'-')
      !
      CALL  TIMING_SEPARATOR('=')
      !
    END IF
    !
    END SUBROUTINE MODEL_n