SUBROUTINE FUNCTION_SENT(IOUTDIAG_UNIT,INDI_BEG,INDI_END,INDJ_BEG,INDJ_END, & NI,NJ, NBFIELDS, & COORDS_1,COORDS_2, & FNC_ANA, IB, CTYPE_FCT, VALUE, CNAME_FILE, CSNDFIELDS) !********************************************************************************************************************* ! IMPLICIT NONE ! #ifdef NO_USE_DOUBLE_PRECISION INTEGER, PARAMETER :: WP = SELECTED_REAL_KIND(6,37) ! real #elif USE_DOUBLE_PRECISION INTEGER, PARAMETER :: WP = SELECTED_REAL_KIND(12,307) ! double #endif ! ! Constants ! REAL (KIND=WP), PARAMETER :: DP_PI=3.14159265359 REAL (KIND=WP), PARAMETER :: DP_LENGTH= 1000.0 REAL (KIND=WP), PARAMETER :: DP_CONV = DP_PI/180. ! INTEGER, INTENT(IN) :: NI,NJ,IB, NBFIELDS INTEGER, INTENT(IN) :: IOUTDIAG_UNIT INTEGER, INTENT(IN) :: INDI_BEG,INDI_END,INDJ_BEG,INDJ_END ! INTEGER :: I,J ! REAL (KIND=WP), INTENT(OUT) :: FNC_ANA(NI,NJ,NBFIELDS) ! REAL (KIND=WP), INTENT(IN) :: COORDS_1(NI,NJ) REAL (KIND=WP), INTENT(IN) :: COORDS_2(NI,NJ) ! CHARACTER(LEN=5), INTENT(IN) :: CTYPE_FCT REAL, INTENT(IN) :: VALUE CHARACTER(LEN=30), INTENT(IN) :: CNAME_FILE CHARACTER(LEN=8), DIMENSION(10), INTENT(IN) :: CSNDFIELDS ! ! IF (CTYPE_FCT .EQ. 'CNSTE') THEN FNC_ANA(:,:,:)=VALUE IF (NBFIELDS .GE. 3) THEN FNC_ANA(:,:,2)=0.0 FNC_ANA(:,:,3)=0.0 END IF ELSE IF (CTYPE_FCT .EQ. 'SINUS') THEN DO J=1,NJ DO I=1,NI FNC_ANA(I,J,:) = VALUE*SIN(COORDS_2(I,J)*DP_CONV*DP_LENGTH + DP_PI/100.0*IB) ENDDO ENDDO ELSE IF (CTYPE_FCT .EQ. 'FILES') THEN CALL READ_FORCING(IOUTDIAG_UNIT,NBFIELDS,INDI_BEG,INDI_END,INDJ_BEG,INDJ_END,IB,CNAME_FILE,CSNDFIELDS,NI,NJ,COORDS_1,COORDS_2,FNC_ANA) ELSE WRITE(IOUTDIAG_UNIT,*) 'PROBLEM DURING DEFINITION OF THE FUNCTION ANALYTIC : ', CTYPE_FCT CALL ABORT END IF ! ! END SUBROUTINE FUNCTION_SENT !