Skip to content
Snippets Groups Projects
spawn_model2.f90 50 KiB
Newer Older
  • Learn to ignore specific revisions
  • !* vertical interpolation
    !
    IF (ANY(XZS(:,:)>0.) .AND. (NDXRATIO/=1 .OR. NDYRATIO/=1) )  THEN
    
      CALL VER_INTERP_FIELD (CTURB,NRR,NSV,ZZZ_LS,XZZ,                             &
                   XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,                          &
                   XSRCT,XSIGS,                                                    &
                   XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM                                 )
    
    ENDIF
    !
    CALL SECOND_MNH(ZTIME2)
    !
    ZVER = ZTIME2 - ZTIME1
    !
    !*       5.7    Absolute pressure :
    !
    ZTIME1 = ZTIME2
    !
    CALL SPAWN_PRESSURE2(NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,   &
    
                         ZZZ_LS,XZZ,ZTHVT,XPABST                    )
    
    !
    IF (.NOT.GNOSON) THEN
      ALLOCATE(ZWORK3D(IIUSON,IJUSON,IKU))
      CALL FMREAD(HSONFILE,'PABST',CLUOUT,'XY',ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
      XPABST(IIB2:IIE2,IJB2:IJE2,:) = ZWORK3D(IIB1:IIE1,IJB1:IJE1,:)
      DEALLOCATE(ZWORK3D)
    END IF
    !
    IF (NVERB>=2) THEN
    
       ALLOCATE(IJCOUNT(IIU,IJU))
       IK4000 = COUNT(XZHAT(:)<4000.)
       IJCOUNT(IIB:IIE,IJB:IJE) = COUNT((ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE)         &
                                  >=MAXVAL(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01),DIM=3 )
       IIJ = MAXLOC( SUM(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3),                  &
            MASK= (  IJCOUNT(IIB:IIE,IJB:IJE) >=1 )                     )           &
    
            + JPHEXT
      WRITE(ILUOUT,*) ' '
      WRITE(ILUOUT,*) 'humidity     (I=',IIJ(1),';J=',IIJ(2),')'
      DO JK=IKB,IKE
    
        WRITE(ILUOUT,'(F6.2,2H %)') ZHUT(IIJ(1),IIJ(2),JK)
    
      END DO
    END IF
    !*       5.8    Retrieve model thermodynamical variables :
    !
    ALLOCATE(ZSUMRT(IIU,IJU,IKU))
    ZSUMRT(:,:,:) = 0.
    IF (NRR==0) THEN
      XTHT(:,:,:) = ZTHVT(:,:,:)
    ELSE
      IF (NDXRATIO/=1 .OR. NDYRATIO/=1) THEN
        XRT(:,:,:,1) = SM_PMR_HU(CLUOUT,XPABST(:,:,:),                          &
                                 ZTHVT(:,:,:)*(XPABST(:,:,:)/XP00)**(XRD/XCPD), &
                                 ZHUT(:,:,:),XRT(:,:,:,:),KITERMAX=100          )
      END IF
      !
      DO JRR=1,NRR
        ZSUMRT(:,:,:) = ZSUMRT(:,:,:) + XRT(:,:,:,JRR)
      END DO
      XTHT(:,:,:) = ZTHVT(:,:,:)/(1.+XRV/XRD*XRT(:,:,:,1))*(1.+ZSUMRT(:,:,:))
    END IF
    !
    DEALLOCATE (ZHUT)
    !
    CALL SECOND_MNH(ZTIME2)
    ZPRESSURE2=ZTIME2-ZTIME1
    !
    !*       5.9   Large Scale field for lbc treatment:
    !
    !
    !*       5.9.1  U variable
    !
    !
    !
    
    XLBXUM(1:NRIMX+1,:,:)         = XUT(IIB:IIB+NRIMX,:,:)
    XLBXUM(NRIMX+2:2*NRIMX+2,:,:) = XUT(IIE+1-NRIMX:IIE+1,:,:)
    
    IF( .NOT. L2D ) THEN
    
      XLBYUM(:,1:NRIMY+1,:)         = XUT(:,IJB-1:IJB-1+NRIMY,:)
      XLBYUM(:,NRIMY+2:2*NRIMY+2,:) = XUT(:,IJE+1-NRIMY:IJE+1,:)
    
    END IF
    !
    !*       5.9.2  V variable
    !
    !
    
    XLBXVM(1:NRIMX+1,:,:)         = XVT(IIB-1:IIB-1+NRIMX,:,:)
    XLBXVM(NRIMX+2:2*NRIMX+2,:,:) = XVT(IIE+1-NRIMX:IIE+1,:,:)
    
    IF( .NOT. L2D ) THEN
    
      XLBYVM(:,1:NRIMY+1,:)         = XVT(:,IJB:IJB+NRIMY,:)
      XLBYVM(:,NRIMY+2:2*NRIMY+2,:) = XVT(:,IJE+1-NRIMY:IJE+1,:)
    
    END IF
    !
    !*       5.9.3  W variable
    !
    !
    
    XLBXWM(1:NRIMX+1,:,:)         = XWT(IIB-1:IIB-1+NRIMX,:,:)
    XLBXWM(NRIMX+2:2*NRIMX+2,:,:) = XWT(IIE+1-NRIMX:IIE+1,:,:)
    
    IF( .NOT. L2D ) THEN
    
      XLBYWM(:,1:NRIMY+1,:)         = XWT(:,IJB-1:IJB-1+NRIMY,:)
      XLBYWM(:,NRIMY+2:2*NRIMY+2,:) = XWT(:,IJE+1-NRIMY:IJE+1,:)
    
    END IF
    !
    !*       5.9.4  TH variable
    !
    !
    
    XLBXTHM(1:NRIMX+1,:,:)         = XTHT(IIB-1:IIB-1+NRIMX,:,:)
    XLBXTHM(NRIMX+2:2*NRIMX+2,:,:) = XTHT(IIE+1-NRIMX:IIE+1,:,:)
    
    IF( .NOT. L2D ) THEN
    
      XLBYTHM(:,1:NRIMY+1,:)         = XTHT(:,IJB-1:IJB-1+NRIMY,:)
      XLBYTHM(:,NRIMY+2:2*NRIMY+2,:) = XTHT(:,IJE+1-NRIMY:IJE+1,:)
    
    END IF
    !
    !*       5.9.5  TKE variable
    !
    !
    IF (HTURB /= 'NONE') THEN
    
      XLBXTKEM(1:NRIMX+1,:,:)         = XTKET(IIB-1:IIB-1+NRIMX,:,:)
      XLBXTKEM(NRIMX+2:2*NRIMX+2,:,:) = XTKET(IIE+1-NRIMX:IIE+1,:,:)
    
      IF( .NOT. L2D ) THEN
    
        XLBYTKEM(:,1:NRIMY+1,:)         = XTKET(:,IJB-1:IJB-1+NRIMY,:)
        XLBYTKEM(:,NRIMY+2:2*NRIMY+2,:) = XTKET(:,IJE+1-NRIMY:IJE+1,:)
    
      END IF
    ENDIF
    ! 
    !
    !*       5.9.6  moist variables
    !
    IF (NRR >= 1) THEN
      DO JRR =1,NRR  
    
        XLBXRM(1:NRIMX+1,:,:,JRR)         = XRT(IIB-1:IIB-1+NRIMX,:,:,JRR)
        XLBXRM(NRIMX+2:2*NRIMX+2,:,:,JRR) = XRT(IIE+1-NRIMX:IIE+1,:,:,JRR)
    
        IF( .NOT. L2D ) THEN
    
          XLBYRM(:,1:NRIMY+1,:,JRR)         = XRT(:,IJB-1:IJB-1+NRIMY,:,JRR)
          XLBYRM(:,NRIMY+2:2*NRIMY+2,:,JRR) = XRT(:,IJE+1-NRIMY:IJE+1,:,JRR)
    
        END IF
      END DO
    END IF
    !
    !*       5.9.7  scalar variables
    !
    IF (NSV /= 0) THEN
      DO JSV = 1, NSV
    
        XLBXSVM(1:NRIMX+1,:,:,JSV)         = XSVT(IIB-1:IIB-1+NRIMX,:,:,JSV)
        XLBXSVM(NRIMX+2:2*NRIMX+2,:,:,JSV) = XSVT(IIE+1-NRIMX:IIE+1,:,:,JSV)
    
        IF( .NOT. L2D ) THEN
    
          XLBYSVM(:,1:NRIMY+1,:,JSV)         = XSVT(:,IJB-1:IJB-1+NRIMY,:,JSV)
          XLBYSVM(:,NRIMY+2:2*NRIMY+2,:,JSV) = XSVT(:,IJE+1-NRIMY:IJE+1,:,JSV)
    
        END IF
      END DO
    ENDIF
    !
    !*       5.10 Surface precipitation computation
    !
    IF (SIZE(XINPRR) /= 0 ) THEN
      IF (GNOSON) &
        CALL SPAWN_SURF2_RAIN (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,   &
                  XINPRC,XACPRC,XINPRR,XINPRR3D,XEVAP3D,                  &
                  XACPRR,XINPRS,XACPRS,XINPRG,XACPRG,&
                  XINPRH,XACPRH )
      IF (.NOT.GNOSON) &
        CALL SPAWN_SURF2_RAIN (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,  &
               XINPRC,XACPRC,XINPRR,XINPRR3D,XEVAP3D,                    &
               XACPRR,XINPRS,XACPRS,XINPRG,XACPRG,XINPRH,XACPRH,         &
               HSONFILE,IIUSON,IJUSON,                                   &
               IIB2,IJB2,IIE2,IJE2,                                      &
               IIB1,IJB1,IIE1,IJE1                                       )
    ENDIF
    !
    !*       5.11   Total mass of dry air Md computation :
    !
    ZTIME1 = ZTIME2
    !
    ALLOCATE(ZRHOD(IIU,IJU,IKU))
    ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
                /(XRD*ZTHVT(:,:,:)*(1.+ZSUMRT(:,:,:)))
    !
    CALL TOTAL_DMASS(CLUOUT,ZJ,ZRHOD,XDRYMASST)
    !
    DEALLOCATE (ZRHOD)
    DEALLOCATE (ZSUMRT,ZTHVT)
    !
    CALL SECOND_MNH(ZTIME2)
    !
    ZMISC = ZMISC + ZTIME2 - ZTIME1
    !
    !*       5.12 Deallocation of model 1 variables : 
    !
    ZTIME1 = ZTIME2
    !
    CALL DEALLOCATE_MODEL1(3)
    !
    CALL SECOND_MNH(ZTIME2)
    !
    ZMISC = ZMISC + ZTIME2 - ZTIME1
    !
    !*       5.13 Anelastic correction : 
    !
    CALL SECOND_MNH(ZTIME1)
    !
    IF (.NOT. L1D) THEN
    
      CALL ANEL_BALANCE_n
    
      CALL BOUNDARIES (                                                 &
                0.,CLBCX,CLBCY,NRR,NSV,1,                               &
                XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM,   &
                XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM,   &
                XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM,   &
                XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM,   &
                XRHODJ,                                                 &
    
                XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT            )
    
    END IF
    !
    CALL SECOND_MNH(ZTIME2)
    !
    ZANEL = ZTIME2 - ZTIME1
    !
    !
    !
    !-------------------------------------------------------------------------------
    !
    !*	 6.    WRITE THE FMFILE
    !	       ---------------- 
    !
    CALL SECOND_MNH(ZTIME1)
    !
    INPRAR = 22 + 2*(4+NRR+NSV) ! 22 = number of grid variables + reference state
                                ! variables +dimension variables
                                ! 2*(4+NRR+NSV) = number of prognostic variables
                                ! at time t and t-dt
    ITYPE=1
    !
    IF ( ( LEN_TRIM(HSPAFILE) /= 0 ) .AND. ( ADJUSTL(HSPAFILE) /= ADJUSTL(CINIFILE) ) ) THEN
      CMY_NAME(2)=HSPAFILE
    ELSE
      CMY_NAME(2)=ADJUSTL(ADJUSTR(CINIFILE)//'.spa'//ADJUSTL(HSPANBR))
      IF (.NOT.GNOSON)   &
         CMY_NAME(2)=ADJUSTL(ADJUSTR(CINIFILE)//'.spr'//ADJUSTL(HSPANBR))
    END IF
    !
    CALL FMOPEN_ll(CMY_NAME(2),'WRITE',CLUOUT,INPRAR,ITYPE,NVERB,ININAR,IRESP)
    !
    YDESFM=ADJUSTL(ADJUSTR(CMY_NAME(2))//'.des')
    !
    CALL WRITE_DESFM_n(2,YDESFM,CLUOUT)
    !
    IF (LBAL_ONLY) THEN  ! same relation with its DAD for model2 and for model1
      NDXRATIO_ALL(2) = NDXRATIO_ALL(1)
      NDYRATIO_ALL(2) = NDYRATIO_ALL(1)
      NXOR_ALL(2)     = NXOR_ALL(1)
      NYOR_ALL(2)     = NYOR_ALL(1)
      NXEND_ALL(2)    = NXEND_ALL(1)
      NYEND_ALL(2)    = NYEND_ALL(1)
      CDAD_NAME(2)    = CDAD_NAME(1)
      IF (CDADSPAFILE == '' ) THEN
        IF (NDXRATIO_ALL(1) == 1 .AND. NDYRATIO_ALL(1) == 1 &
          .AND. NXOR_ALL(1) == 1 .AND. NYOR_ALL(1) == 1 ) THEN
          ! for spawning with ratio=1 
          ! if the DAD of model 1 is itself, the DAD of model 2 also.
          CDAD_NAME(2)=CMY_NAME(2)
        ENDIF
      ENDIF
      ! case of model with DAD
      IF (CDADSPAFILE /='') CDAD_NAME(2)=CDADSPAFILE
    ELSE
      CDAD_NAME(2)=CMY_NAME(1) ! model 1 becomes the DAD of model 2 (spawned one)
    ENDIF
    !
    #ifdef MNH_NCWRIT
    NC_WRITE = LNETCDF
    CALL WRITE_LFIFM_n(CMY_NAME(2),CDAD_NAME(2))
    IF ( LNETCDF ) THEN
      DEF_NC=.FALSE.
      CALL WRITE_LFIFM_n(CMY_NAME(2),CDAD_NAME(2))
      DEF_NC=.TRUE.
    END IF
    #else
    CALL WRITE_LFIFM_n(CMY_NAME(2),CDAD_NAME(2))
    #endif
    !
    CALL SECOND_MNH(ZTIME2)
    !
    ZWRITE = ZTIME2 - ZTIME1
    !
    !-------------------------------------------------------------------------------
    !
    !*       7.      Surface variables :
    !
    ZTIME1 = ZTIME2
    !
    CALL SPAWN_SURF(HINIFILE,HINIFILEPGD,OSPAWN_SURF)
    !
    CALL SECOND_MNH(ZTIME2)
    !
    ZSURF2 = ZTIME2 - ZTIME1
    !
    !-------------------------------------------------------------------------------
    !
    !*	 8.    CLOSES THE FMFILE
    !	       ----------------- 
    !
    CALL FMCLOS_ll(CMY_NAME(2),'KEEP',CLUOUT,IRESP)
    IF (LEN_TRIM(HSONFILE) /= 0 ) THEN
      CALL FMCLOS_ll(HSONFILE,'KEEP',CLUOUT,IRESP)
    END IF
    !
    !-------------------------------------------------------------------------------
    !
    !*       9.    PRINTS ON OUTPUT-LISTING
    !              ------------------------
    !
    WRITE(ILUOUT,FMT=9900) XZHAT(1)
    !
    DO JLOOP = 2,IKU
     WRITE(ILUOUT,FMT=9901) JLOOP,XZHAT(JLOOP),XZHAT(JLOOP)-XZHAT(JLOOP-1)
    END DO
    !
    IF (NVERB >= 5) THEN
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERV,LUSERC=',LUSERV,LUSERC 
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERR,LUSERI,LUSERS=',LUSERR,LUSERI,LUSERS
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERG,LUSERH,NSV=',LUSERG,LUSERH,NSV
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: NRR=',NRR
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: NVERB=',NVERB
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: XLON0,XLAT0,XBETA=',XLON0,XLAT0,XBETA
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: LCARTESIAN=',LCARTESIAN
      IF(LCARTESIAN) THEN
        WRITE(ILUOUT,*) 'SPAWN_MODEL2: No map projection used.'
      ELSE
        WRITE(ILUOUT,*) 'SPAWN_MODEL2: XRPK,XLONORI,XLATORI=',XRPK,XLONORI,XLATORI
        IF (ABS(XRPK) == 1.) THEN
          WRITE(ILUOUT,*) 'SPAWN_MODEL2: Polar stereo used.'
        ELSE IF (XRPK == 0.) THEN
          WRITE(ILUOUT,*) 'SPAWN_MODEL2: Mercator used.'
        ELSE
          WRITE(ILUOUT,*) 'SPAWN_MODEL2: Lambert used, cone factor=',XRPK 
        END IF
      END IF
    END IF
    !
    IF (NVERB >= 10) THEN
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: IIB, IJB, IKB=',IIB,IJB,IKB
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: IIU, IJU, IKU=',IIU,IJU,IKU
    END IF
    !
    IF(NVERB >= 10) THEN                               !Value control
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XZS values:'
      WRITE(ILUOUT,*) XZS(1,IJU),XZS((IIU-1)/2,IJU),XZS(IIU,IJU)  
      WRITE(ILUOUT,*) XZS(1,(IJU-1)/2),XZS((IIU-1)/2,(IJU-1)/2),XZS(IIU,(IJU-1)/2)  
      WRITE(ILUOUT,*) XZS(1,1)      ,XZS((IIU-1)/2,1)      ,XZS(IIU,1)  
    END IF
    !
    IF(NVERB >= 10) THEN       !Value control
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XUT values:'
      WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                       &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
      DO JKLOOP=1,IKU
        WRITE(ILUOUT,*) 'JK = ',JKLOOP
        WRITE(ILUOUT,*) XUT(1,IJU/2,JKLOOP),XUT(IIU/2,1,JKLOOP),       &
                        XUT(IIU/2,IJU/2,JKLOOP),XUT(IIU/2,IJU,JKLOOP), &
                        XUT(IIU,IJU/2,JKLOOP)
      END DO
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XVT values:'
      WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                       &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
      DO JKLOOP=1,IKU
        WRITE(ILUOUT,*) 'JK = ',JKLOOP
        WRITE(ILUOUT,*) XVT(1,IJU/2,JKLOOP),XVT(IIU/2,1,JKLOOP),       &
                        XVT(IIU/2,IJU/2,JKLOOP),XVT(IIU/2,IJU,JKLOOP), &
                        XVT(IIU,IJU/2,JKLOOP)
      END DO
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XWT values:'
      WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                       &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
      DO JKLOOP=1,IKU
        WRITE(ILUOUT,*) 'JK = ',JKLOOP
        WRITE(ILUOUT,*) XWT(1,IJU/2,JKLOOP),XWT(IIU/2,1,JKLOOP),       &
                        XWT(IIU/2,IJU/2,JKLOOP),XWT(IIU/2,IJU,JKLOOP), &
                        XWT(IIU,IJU/2,JKLOOP)
      END DO
      WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XTHT values:'
      WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                       &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
      DO JKLOOP=1,IKU
        WRITE(ILUOUT,*) 'JK = ',JKLOOP
        WRITE(ILUOUT,*) XTHT(1,IJU/2,JKLOOP),XTHT(IIU/2,1,JKLOOP),       &
                        XTHT(IIU/2,IJU/2,JKLOOP),XTHT(IIU/2,IJU,JKLOOP), &
                        XTHT(IIU,IJU/2,JKLOOP)
      END DO
      IF(NRR >= 1) THEN
        WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XRT values:'
        WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
                         &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
        DO JKLOOP=1,IKU
          WRITE(ILUOUT,*) 'JK = ',JKLOOP
          WRITE(ILUOUT,*) XRT(1,IJU/2,JKLOOP,1),XRT(IIU/2,1,JKLOOP,1),       &
                          XRT(IIU/2,IJU/2,JKLOOP,1),XRT(IIU/2,IJU,JKLOOP,1), &
                          XRT(IIU,IJU/2,JKLOOP,1)
        END DO
      END IF
      !
      IF (LUV_FLX) THEN
        WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XVU_FLUX(IIU/2,2,:)=',XVU_FLUX_M(IIU/2,2,:)
      END IF
      !
      IF (LTH_FLX) THEN
        WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XVTH_FLUX(IIU/2,2,:)=',XVTH_FLUX_M(IIU/2,2,:)
        WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XWTH_FLUX(IIU/2,2,:)=',XWTH_FLUX_M(IIU/2,2,:)
      END IF
      !
    END IF
    !
    WRITE(ILUOUT,*) 'SPAWN_MODEL2: SPAWN_MODEL2 ENDS CORRECTLY.'
    !
    CALL SECOND_MNH (ZEND)
    !
    ZTOT        = ZEND - ZSTART          ! for computing time analysis
    !
    ZALL = ZGRID2 + ZSURF2 + ZMISC + ZFIELD2 + ZVER + ZPRESSURE2 + ZANEL + ZWRITE
    !
    ZPERCALL  = 100.*ZALL/ZTOT
    !
    ZPERCGRID2  = 100.*ZGRID2/ZTOT
    ZPERCSURF2  = 100.*ZSURF2/ZTOT
    ZPERCMISC   = 100.*ZMISC/ZTOT
    ZPERCFIELD2 = 100.*ZFIELD2/ZTOT
    ZPERCVER    = 100.*ZVER/ZTOT
    ZPERCPRESSURE2 = 100.*ZPRESSURE2/ZTOT
    ZPERCANEL   = 100.*ZANEL/ZTOT
    ZPERCWRITE  = 100.*ZWRITE/ZTOT
    !
    WRITE(ILUOUT,*)
    WRITE(ILUOUT,*) ' ------------------------------------------------------------ '
    WRITE(ILUOUT,*) '|                                                            |'
    WRITE(ILUOUT,*) '|           COMPUTING TIME ANALYSIS in SPAWN_MODEL2          |'
    WRITE(ILUOUT,*) '|                                                            |'
    WRITE(ILUOUT,*) '|------------------------------------------------------------|'
    WRITE(ILUOUT,*) '|                     |                   |                  |'
    WRITE(ILUOUT,*) '|    ROUTINE NAME     |     CPU-TIME      |   PERCENTAGE %   |'
    WRITE(ILUOUT,*) '|                     |                   |                  |'
    WRITE(ILUOUT,*) '|---------------------|-------------------|------------------|'
    WRITE(ILUOUT,*) '|                     |                   |                  |'
    WRITE(UNIT=ILUOUT,FMT=1) ZGRID2 ,ZPERCGRID2
    WRITE(UNIT=ILUOUT,FMT=3) ZFIELD2,ZPERCFIELD2
    WRITE(UNIT=ILUOUT,FMT=8) ZVER,ZPERCVER
    WRITE(UNIT=ILUOUT,FMT=7) ZPRESSURE2,ZPERCPRESSURE2
    WRITE(UNIT=ILUOUT,FMT=2) ZSURF2 ,ZPERCSURF2
    WRITE(UNIT=ILUOUT,FMT=4) ZANEL  ,ZPERCANEL
    WRITE(UNIT=ILUOUT,FMT=5) ZWRITE ,ZPERCWRITE
    WRITE(UNIT=ILUOUT,FMT=9) ZMISC  ,ZPERCMISC
    WRITE(UNIT=ILUOUT,FMT=6) ZTOT   ,ZPERCALL
    WRITE(ILUOUT,*) ' ------------------------------------------------------------ '
    !
    !                  FORMATS
    !                  -------
    !
    1  FORMAT(' |    SPAWN_GRID2      |     ',F8.3,'      |     ',F8.3,'     |')
    3  FORMAT(' |    SPAWN_FIELD2     |     ',F8.3,'      |     ',F8.3,'     |')
    8  FORMAT(' |  VER_INTERP_FIELD   |     ',F8.3,'      |     ',F8.3,'     |')
    7  FORMAT(' |  SPAWN_PRESSURE2    |     ',F8.3,'      |     ',F8.3,'     |')
    2  FORMAT(' |    SPAWN_SURF2      |     ',F8.3,'      |     ',F8.3,'     |')
    4  FORMAT(' |   ANEL_BALANCE2     |     ',F8.3,'      |     ',F8.3,'     |')
    5  FORMAT(' |      WRITE          |     ',F8.3,'      |     ',F8.3,'     |')
    9  FORMAT(' |   MISCELLANEOUS     |     ',F8.3,'      |     ',F8.3,'     |')
    6  FORMAT(' |    SPAWN_MODEL2     |     ',F8.3,'      |     ',F8.3,'     |')
    !
    !
    CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
    !
    9900  FORMAT(' K = 001    ZHAT = ',E14.7)
    9901  FORMAT(' K = ',I3.3,'    ZHAT = ',E14.7,'    DZ = ' ,E14.7)
    !
    !-------------------------------------------------------------------------------
    !
    !
    ! Switch back to model index of calling routine
    CALL GOTO_MODEL(IMI)
    !
    END SUBROUTINE SPAWN_MODEL2