Skip to content
Snippets Groups Projects
read_field.f90 48.4 KiB
Newer Older
  • Learn to ignore specific revisions
  •     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