Skip to content
Snippets Groups Projects
modeln.f90 92.9 KiB
Newer Older
VIE Benoit's avatar
VIE Benoit committed
    IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. &
                                 (CCLOUD == 'LIMA' .AND. NMOM_I.GE.1 ) ) THEN
      XACPRS = XACPRS + XINPRS * XTSTEP
      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( YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
                                    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  )
VIE Benoit's avatar
VIE Benoit committed
!
      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