cvsp_init.f

Go to the documentation of this file.

!                   ********************
                    SUBROUTINE cvsp_init
!                   ********************
!
!***********************************************************************
! SISYPHE   V7P2                                   16/05/2017
!***********************************************************************
!
!brief   INITS A VERTICAL SORTING PROFILE BY USING HIRANO LAYERS
!        OR USER CODING
!
!history UWE MERKEL
!+        20/07/2011
!+        V6P2
!+
!
!history  P. A. TASSI (EDF R&D, LNHE)
!+        12/03/2013
!+        V6P3
!+   Cleaning, cosmetic
!
!history U. MERKEL, R.KOPMANN (BAW)
!+        21/07/2016
!+        V6P3, V7P2
!+   Integrating init_from_layers in this subroutine
!
!history R.KOPMANN (BAW)
!+        19/02/2019
!+        V7P2
!+   Initial volume calculated with CVSP variables
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| J              |<--| INDEX OF A POINT IN MESH
!| I              |<--| INDEX OF A FRACTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_sisyphe
      USE cvsp_outputfiles, ONLY: cp
      USE interface_parallel, ONLY : p_dsum
!
      IMPLICIT NONE
!
      INTEGER  I,J,K,L,M
      DOUBLE PRECISION DEPTH
      LOGICAL RET, CVSP_CHECK_L, CVSP_CHECK_F
!
!-----------------------------------------------------------------------
!
      IF(cp) WRITE(lu,*) 'CVSP_INIT'

      DO j=1,npoin
        DO k=1,nomblay
          ret =  cvsp_check_l(j,k,' CVSP_INIT:  ')
        ENDDO
      ENDDO
!
      ALLOCATE(pro_d(npoin,pro_max_max,nsicla))
      ALLOCATE(pro_f(npoin,pro_max_max,nsicla))
      ALLOCATE(pro_max(npoin))
!
!-----------------------------------------------------------------------
!
      DO j=1,npoin
        depth = 0.d0                 ! INIT DEPTH OF THE VSP
        pro_max(j) =  2* nlayer%I(j) ! 2 SECTION POINTS PER LAYER
        l = pro_max(j)+1
!
!-----------------------------------------------------------------------
! BUILDING SECTIONS
!-----------------------------------------------------------------------
!
        DO m=1,nlayer%I(j)
          IF (abs(es(j,m)).GT.0.d0) THEN
            l = l - 1
            DO i=1,nsicla
              pro_d(j,l,i) = zf%R(j) - depth
              pro_f(j,l,i) = avail(j,m,i)
            ENDDO
            depth = depth + es(j,m)
            l = l - 1
            DO i=1,nsicla
              pro_d(j,l,i) = zf%R(j) - depth
              IF(m==nlayer%I(j)) THEN
                pro_f(j,l,i) = avail(j,m,i)
              ELSE
                pro_f(j,l,i) = avail(j,m+1,i)
              ENDIF
            ENDDO
            ret =  cvsp_check_f(j,l,'FromLay:  ')
          ENDIF
        ENDDO

!-----------------------------------------------------------------------
! USER CODING
!-----------------------------------------------------------------------
!        PRO_MAX(J) = PRO_MAX_MAX
!        DO K=1,PRO_MAX(J)
!          DO I=1,NSICLA
!            PRO_D(J,K,I) = (ZF%R(J)-ZF%R(J))/PRO_MAX(J)*K
!            PRO_F(J,K,1) = 1.D0 / NSICLA
!          ENDDO
!-----------------------------------------------------------------------
! FINAL CHECKS
!-----------------------------------------------------------------------
        IF (abs(zf%R(j) - zr%R(j) - depth).GT.10.d-6) THEN
          WRITE(lu,*)'Depth Synchro Error for Point J: ',j
          WRITE(lu,*)zf%R(j),zr%R(j),depth,abs(zf%R(j)-zr%R(j)-depth)
        ENDIF
!
      ENDDO !J=1,NPOIN
!-----------------------------------------------------------------------
      DO j=1,npoin
        DO l=1,pro_max(j)
          ret =  cvsp_check_f(j,l,'AfterLAY:  ')
        END DO
        CALL cvsp_check_steady(j)
      END DO

!-----------------------------------------------------------------------
      CALL cvsp_check_anything()

!INITIALISIATION OUTPUT TO SERAFIN FILE
      IF (cvsm_out_full) CALL cvsp_output_init()
      IF (cvsm_out_full) CALL cvsp_write_profile()
!
! CALCULATING THE VOLUME SEEN FROM CVSM MODEL
      DO i = 1, nsicla
        voltot(i) = 0.d0
      ENDDO
!
      DO i=1,nsicla
        DO j=1,npoin
          DO k=1,pro_max(j)-1
            voltot(i) = voltot(i) + (pro_f(j,k,i)+pro_f(j,k+1,i))/2.d0
     &           *(pro_d(j,k+1,i)-pro_d(j,k,i))*volu2d%R(j)
          ENDDO
        ENDDO
      ENDDO
      IF(ncsize.GT.1) THEN
        DO i=1,nsicla
          voltot(i) = p_dsum(voltot(i))
        ENDDO
      ENDIF
!
      DO i=1,nsicla
        volini(i) = voltot(i)
      ENDDO
!
      RETURN
      END SUBROUTINE cvsp_init