Skip to content
Snippets Groups Projects
read_field.f90 48.3 KiB
Newer Older
    YRECFM='RSVS_CLD2'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH,  &
         YCOMMENT,IRESP)
    PRSVS_CLD(:,:,:,JSV) = Z3D(:,:,:)
   END IF
  END DO
END IF
!
!*       2.1  Time t-dt:
!
IF (CPROGRAM=='MESONH' .AND. HUVW_ADV_SCHEME(1:3)=='CEN' .AND. &
        HTEMP_SCHEME == 'LEFR' ) THEN
  IF (CCONF=='RESTA') THEN
    YRECFM = 'UM'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PUM,IGRID,ILENCH,YCOMMENT,IRESP)
    !
    YRECFM = 'VM'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PVM,IGRID,ILENCH,YCOMMENT,IRESP)
    !
    YRECFM = 'WM'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PWM,IGRID,ILENCH,YCOMMENT,IRESP)
    !
    YRECFM = 'DUM'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PDUM,IGRID,ILENCH,YCOMMENT,IRESP)
    !
    YRECFM = 'DVM'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PDVM,IGRID,ILENCH,YCOMMENT,IRESP)
    !
    YRECFM = 'DWM'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PDWM,IGRID,ILENCH,YCOMMENT,IRESP)
  ELSE
    PUM = PUT
    PVM = PVT
    PWM = PWT
  END IF
END IF
!
!*       2.2a  3D LS fields  
!
!
CALL INI_LS(HINIFILE,HLUOUT,HGETRVT,GLSOURCE,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM)
!
!
!*       2.2b  2D "surfacic" LB fields   
!
!
CALL INI_LB(HINIFILE,HLUOUT,GLSOURCE,ISV,                             &   
     KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll,               &
     KSIZELBXTKE_ll,KSIZELBYTKE_ll,                                   &
     KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll,           &
     HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETRST,                &
     HGETRGT,HGETRHT,HGETSVT,                                         &
     PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM,            &
     PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM             ) 
!
!
!*       2.3  Some special variables:
!
YRECFM = 'DRYMASST'                  ! dry mass
YDIR='--'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PDRYMASST,IGRID,ILENCH,YCOMMENT,IRESP)
!
SELECT CASE(HGETSRCT)                ! turbulent flux SRC at time t
  CASE('READ')
    YRECFM='SRCT'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH,  &
                YCOMMENT,IRESP)
    IF( IRESP /= 0 ) THEN
      YRECFM='SRC'
      YDIR='XY'
      CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH,  &
                  YCOMMENT,IRESP)
    END IF
    PSRCT(:,:,:)=Z3D(:,:,:)
  CASE('INIT')
    PSRCT(:,:,:)=0.
END SELECT
!
SELECT CASE(HGETSIGS)                ! subgrid condensation
  CASE('READ')
    YRECFM='SIGS'
    YDIR='XY' 
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PSIGS,IGRID,ILENCH,  &
                YCOMMENT,IRESP)
  CASE('INIT')
    PSIGS(:,:,:)=0.
END SELECT
!
SELECT CASE(HGETPHC)             ! pH in cloud water
  CASE('READ')
    YRECFM='PHC'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PPHC,IGRID,ILENCH,  &
                YCOMMENT,IRESP)
  CASE('INIT')
END SELECT
!
SELECT CASE(HGETPHR)             ! pH in rainwater
  CASE('READ')
    YRECFM='PHR'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PPHR,IGRID,ILENCH,  &
                YCOMMENT,IRESP)
  CASE('INIT')
END SELECT
!
IRESP=0
IF(HGETCLDFR=='READ') THEN           ! cloud fraction
    YRECFM='CLDFR'
    YDIR='XY' 
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PCLDFR,IGRID,ILENCH,  &
                YCOMMENT,IRESP)
ENDIF
IF(HGETCLDFR=='INIT' .OR. IRESP /= 0) THEN
  IF(SIZE(PRT,4) > 3) THEN
    WHERE(PRT(:,:,:,2)+PRT(:,:,:,4) > 1.E-30)
      PCLDFR(:,:,:) = 1.
    ELSEWHERE
      PCLDFR(:,:,:) = 0.
    ENDWHERE
  ELSE
    WHERE(PRT(:,:,:,2) > 1.E-30)
      PCLDFR(:,:,:) = 1.
    ELSEWHERE
      PCLDFR(:,:,:) = 0.
    ENDWHERE
  ENDIF
ENDIF
!
!* boundary layer depth
!
IF (HGETBL_DEPTH=='READ') THEN
  YRECFM = 'BL_DEPTH'
  YDIR='XY'
  CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PBL_DEPTH,IGRID,ILENCH,YCOMMENT,IRESP)
ELSE
  PBL_DEPTH(:,:)=XUNDEF
END IF
!
!* surface boundary layer depth
!
IF (HGETSBL_DEPTH=='READ') THEN
  YRECFM = 'SBL_DEPTH'
  YDIR='XY'
  CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PSBL_DEPTH,IGRID,ILENCH,YCOMMENT,IRESP)
ELSE
  PSBL_DEPTH(:,:)=0.
END IF
!
!* Contribution from MAss Flux parameterizations to vert. flux of buoyancy
!
SELECT CASE(HGETTKET)                   
  CASE('READ') 
    YRECFM = 'WTHVMF'
    YDIR='XY'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PWTHVMF,IGRID,ILENCH,YCOMMENT,IRESP)
  CASE('INIT')
    PWTHVMF(:,:,:)=0.
END SELECT 
!-------------------------------------------------------------------------------
!
!*       2.4   READ FORCING VARIABLES
!              ----------------------
!
!
IF ( LFORCING ) THEN
  DO JT=1,KFRC
!
    WRITE (YFRC,'(I3.3)') JT
    YRECFM='DTFRC'//YFRC//'%TDATE' ! array of rank 3 for date
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
    TPDTFRC(JT)%TDATE%YEAR  = ITDATE(1)
    TPDTFRC(JT)%TDATE%MONTH = ITDATE(2)
    TPDTFRC(JT)%TDATE%DAY   = ITDATE(3)
    YRECFM='DTFRC'//YFRC//'%TIME'
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TPDTFRC(JT)%TIME,IGRID,ILENCH, &
                YCOMMENT,IRESP)
!
    YRECFM='UFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
    PUFRC(:,JT)=Z1D(:)
!
    YRECFM='VFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
    PVFRC(:,JT)=Z1D(:)
!
    YRECFM='WFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
    PWFRC(:,JT)=Z1D(:)
!
    YRECFM='THFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
    PTHFRC(:,JT)=Z1D(:)
!
    YRECFM='RVFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
    PRVFRC(:,JT)=Z1D(:)
!
    YRECFM='TENDTHFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
    PTENDTHFRC(:,JT)=Z1D(:)
!
    YRECFM='TENDRVFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
    PTENDRVFRC(:,JT)=Z1D(:)
!
    YRECFM='GXTHFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
    PGXTHFRC(:,JT)=Z1D(:)
!
    YRECFM='GYTHFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
    PGYTHFRC(:,JT)=Z1D(:)
!
    YRECFM='PGROUNDFRC'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PPGROUNDFRC(JT),IGRID,ILENCH,YCOMMENT,IRESP)
!
  END DO
END IF
!
!-------------------------------------------------------------------------------
IF (L2D_ADV_FRC) THEN

  DO JT=1,KADVFRC  

    WRITE (YFRC,'(I3.3)') JT
    YRECFM='DTADV'//YFRC//'%TDATE' ! array of rank 3 for date
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
    TPDTADVFRC(JT)%TDATE%YEAR  = ITDATE(1)
    TPDTADVFRC(JT)%TDATE%MONTH = ITDATE(2)
    TPDTADVFRC(JT)%TDATE%DAY   = ITDATE(3)
    !
    YRECFM='DTADV'//YFRC//'%TIME'
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TPDTADVFRC(JT)%TIME,IGRID,ILENCH, &
	    YCOMMENT,IRESP)
    YRECFM='TH_ADV'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XDTH3D,IGRID,ILENCH,  &
                                                         YCOMMENT,IRESP)
    PDTHFRC(:,:,:,JT)=XDTH3D(:,:,:)
    !
    YRECFM='Q_ADV'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XDRV3D,IGRID,ILENCH,  &
                                                         YCOMMENT,IRESP)
    
    PDRVFRC(:,:,:,JT)=XDRV3D(:,:,:)
  ENDDO
ENDIF
!
IF (L2D_REL_FRC) THEN

  DO JT=1,KRELFRC  

    WRITE (YFRC,'(I3.3)') JT
    YRECFM='DTREL'//YFRC//'%TDATE' ! array of rank 3 for date
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
    TPDTRELFRC(JT)%TDATE%YEAR  = ITDATE(1)
    TPDTRELFRC(JT)%TDATE%MONTH = ITDATE(2)
    TPDTRELFRC(JT)%TDATE%DAY   = ITDATE(3)

    ! Relaxation

    YRECFM='TH_REL'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XDTH3D,IGRID,ILENCH,  &
                                                         YCOMMENT,IRESP)
    
    PTHREL(:,:,:,JT)=XDTH3D(:,:,:)
    !
    YRECFM='Q_REL'//YFRC
    YDIR='--'
    CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XDRV3D,IGRID,ILENCH,  &
                                                         YCOMMENT,IRESP)

    PRVREL(:,:,:,JT)=XDRV3D(:,:,:)

    ENDDO

ENDIF

!
IF (LUV_FLX) THEN
   IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN 
       YRECFM='VU_FLX'
       YDIR='--'
       CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PVU_FLUX_M,IGRID, &
                   ILENCH,YCOMMENT,IRESP)
   ELSE IF (CCONF == 'START') THEN
       PVU_FLUX_M(:,:,:)=0.
   END IF
ENDIF
!
IF (LTH_FLX) THEN
   IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN 
       YRECFM='VT_FLX'
       YDIR='--'
       CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PVTH_FLUX_M,IGRID, &
                   ILENCH,YCOMMENT,IRESP)
       YRECFM='WT_FLX'
       YDIR='--'
       CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PWTH_FLUX_M,IGRID, &
                   ILENCH,YCOMMENT,IRESP)       
   ELSE IF (CCONF == 'START') THEN
       PWTH_FLUX_M(:,:,:)=0.
       PVTH_FLUX_M(:,:,:)=0.
   END IF
ENDIF
!
!-------------------------------------------------------------------------------
!
!
!*       3.    PRINT ON OUTPUT-LISTING
!              ----------------------
!
IF (NVERB >= 10 .AND. .NOT. L1D) THEN
  IIUP = SIZE(PUT,1)
  IJUP = SIZE(PVT,2) 
  CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
! 
  WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PUT values:'
  WRITE(ILUOUT,FMT=*) '(1,1,JK)   (IIU/2,IJU/2,JK)   (IIU,IJU,JK)    JK  '
  DO JKLOOP=1,KKU
    WRITE(ILUOUT,FMT=*) PUT(1,1,JKLOOP),PUT(IIUP/2,IJUP/2,JKLOOP), &
    PUT(IIUP,KJU,JKLOOP),JKLOOP    
  END DO
!
  WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PVT values:'
  WRITE(ILUOUT,FMT=*) '(1,1,JK)   (IIU/2,IJU/2,JK)   (IIU,IJU,JK)    JK  '
  DO JKLOOP=1,KKU
    WRITE(ILUOUT,FMT=*) PVT(1,1,JKLOOP),PVT(IIUP/2,IJUP/2,JKLOOP), &
    PVT(IIUP,IJUP,JKLOOP),JKLOOP    
  END DO
!
  WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PWT values:'
  WRITE(ILUOUT,FMT=*) '(1,1,JK)   (IIU/2,IJU/2,JK)   (IIU,IJU,JK)    JK  '
  DO JKLOOP=1,KKU
    WRITE(ILUOUT,FMT=*) PWT(1,1,JKLOOP),PWT(IIUP/2,IJUP/2,JKLOOP), &
    PWT(IIUP,IJUP,JKLOOP),JKLOOP    
  END DO
!
  WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTHT values:'
  WRITE(ILUOUT,FMT=*) '(1,1,JK)   (IIU/2,IJU/2,JK)   (IIU,IJU,JK)    JK  '
  DO JKLOOP=1,KKU
    WRITE(ILUOUT,FMT=*) PTHT(1,1,JKLOOP),PTHT(IIUP/2,IJUP/2,JKLOOP), &
    PTHT(IIUP,IJUP,JKLOOP),JKLOOP    
  END DO
!
  IF(SIZE(PTKET,1) /=0) THEN
    WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTKET values:'
    WRITE(ILUOUT,FMT=*) '(1,1,JK)   (IIU/2,IJU/2,JK)   (IIU,IJU,JK)    JK  '
    DO JKLOOP=1,KKU
      WRITE(ILUOUT,FMT=*) PTKET(1,1,JKLOOP),PTKET(IIUP/2,IJUP/2,JKLOOP), &
      PTKET(IIUP,IJUP,JKLOOP),JKLOOP    
    END DO
  END IF
!
  IF (SIZE(PRT,4) /= 0) THEN
    WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PRT values:'
    DO JRR = 1, SIZE(PRT,4)
      WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
      WRITE(ILUOUT,FMT=*) '(1,1,JK)   (IIU/2,IJU/2,JK)   (IIU,IJU,JK)    JK  '
      DO JKLOOP=1,KKU
        WRITE(ILUOUT,FMT=*) PRT(1,1,JKLOOP,JRR),PRT(IIUP/2,IJUP/2,JKLOOP,JRR), &
        PRT(IIUP,IJUP,JKLOOP,JRR),JKLOOP    
      END DO
    END DO
!
  END IF   
!
  IF (SIZE(PSVT,4) /= 0) THEN
    WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PSVT values:'
    DO JRR = 1, SIZE(PSVT,4)
      WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
      WRITE(ILUOUT,FMT=*) '(1,1,JK)   (IIU/2,IJU/2,JK)   (IIU,IJU,JK)    JK  '
      DO JKLOOP=1,KKU
        WRITE(ILUOUT,FMT=*) PSVT(1,1,JKLOOP,JRR),PSVT(IIUP/2,IJUP/2,JKLOOP,JRR), &
        PSVT(IIUP,IJUP,JKLOOP,JRR),JKLOOP    
      END DO
    END DO
!
  END IF   
END IF 
!-------------------------------------------------------------------------------
!
END SUBROUTINE READ_FIELD