Skip to content
Snippets Groups Projects
Commit 57399d1f authored by WURTZ Jean's avatar WURTZ Jean Committed by Jean Wurtz
Browse files

Jean Wurtz pgd_cover.F90 Bugfix when water fraction is 1

parent 9d7f29ad
No related branches found
No related tags found
No related merge requests found
......@@ -573,7 +573,7 @@ ELSE
!
CALL FIT_COVERS(XDATA_NATURE,U%XNATURE,4,ICOVER,IC_NAT)
CALL FIT_COVERS(XDATA_TOWN ,U%XTOWN ,7,ICOVER,IC_TWN)
CALL FIT_COVERS(XDATA_WATER ,U%XWATER ,2,ICOVER,IC_WAT)
CALL FIT_COVERS(XDATA_WATER ,U%XWATER ,2,ICOVER,IC_WAT,KSURF_ADDITIONNAL=3) ! Jean Wurtz Adding KSURF_ADDITIONNAL TO ADD RIVER WHICH CAN BE =1 AT HIGH RESOLUTION
CALL FIT_COVERS(XDATA_SEA ,U%XSEA ,1,ICOVER,IC_SEA)
!
ALLOCATE(ZCOVER_NATURE(NL,ICOVER))
......@@ -641,6 +641,7 @@ ELSE
'*********************************************************************'
NSIZE(:,1) = 1
WHERE (U%XWATER(:).NE.0. .AND. ZWATER(:).EQ.0.) NSIZE(:,1)=0
!IC_WAT=0
! if water imposed to 1 in a grid cell: no extrapolation
DO JL=1,SIZE(U%XCOVER,1)
IF(U%XWATER(JL)==1.0)THEN
......@@ -733,15 +734,17 @@ IF (LHOOK) CALL DR_HOOK('PGD_COVER',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
CONTAINS
!
SUBROUTINE FIT_COVERS(PDATA_SURF,PSURF,KSURF,KCOVER,KC_SURF)
SUBROUTINE FIT_COVERS(PDATA_SURF,PSURF,KSURF,KCOVER,KC_SURF,KSURF_ADDITIONNAL)
!
REAL, DIMENSION(:), INTENT(IN) :: PDATA_SURF
REAL, DIMENSION(:), INTENT(IN) :: PSURF
INTEGER, INTENT(IN) :: KSURF
INTEGER, INTENT(INOUT) :: KCOVER
INTEGER, INTENT(OUT) :: KC_SURF
INTEGER, INTENT(IN), OPTIONAL :: KSURF_ADDITIONNAL
!
LOGICAL :: GPRESENT
LOGICAL :: G_IS_PRESENT_ADDITIONNAL_KSURF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PGD_COVER:FIT_COVERS',0,ZHOOK_HANDLE)
......@@ -754,15 +757,30 @@ DO JCOV=1,KCOVER
ENDIF
ENDDO
!
G_IS_PRESENT_ADDITIONNAL_KSURF=.FALSE.
IF (PRESENT(KSURF_ADDITIONNAL)) THEN
G_IS_PRESENT_ADDITIONNAL_KSURF=.TRUE.
END IF
IF (ANY(PSURF(:)/=0.)) THEN
!
IF (GPRESENT) THEN
!
DO JCOV=1,KCOVER
IF (IMASK_COVER(JCOV)==KSURF) THEN
KC_SURF = JCOV
EXIT
ENDIF
IF (G_IS_PRESENT_ADDITIONNAL_KSURF) THEN
IF (IMASK_COVER(JCOV)==KSURF .OR. IMASK_COVER(JCOV)==KSURF_ADDITIONNAL) THEN
KC_SURF = JCOV
EXIT
ENDIF
ELSE
IF (IMASK_COVER(JCOV)==KSURF) THEN
KC_SURF = JCOV
EXIT
ENDIF
END IF
ENDDO
!
ELSE
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment