| Directory: | ./ |
|---|---|
| File: | rad/swuvo3.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 16 | 19 | 84.2% |
| Branches: | 11 | 18 | 61.1% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | 28080 | SUBROUTINE SWUVO3 & | |
| 2 | & ( KIDIA,KFDIA,KLON,KNU,KABS,& | ||
| 3 | 28080 | & PU, PTR & | |
| 4 | & ) | ||
| 5 | |||
| 6 | !**** *SWUVO3* - COMPUTES THE SHORTWAVE TRANSMISSION FUNCTIONS | ||
| 7 | |||
| 8 | ! PURPOSE. | ||
| 9 | ! -------- | ||
| 10 | ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR OZONE | ||
| 11 | ! IN THE UV and VISIBLE SPECTRAL INTERVALS. | ||
| 12 | |||
| 13 | !** INTERFACE. | ||
| 14 | ! ---------- | ||
| 15 | ! *SWUVO3* IS CALLED FROM *SW1S*. | ||
| 16 | |||
| 17 | ! EXPLICIT ARGUMENTS : | ||
| 18 | ! -------------------- | ||
| 19 | ! KNU : ; INDEX OF THE SPECTRAL INTERVAL | ||
| 20 | ! KABS : ; NUMBER OF ABSORBERS | ||
| 21 | ! PU : (KLON,KABS) ; ABSORBER AMOUNT | ||
| 22 | ! ==== OUTPUTS === | ||
| 23 | ! PTR : (KLON,KABS) ; TRANSMISSION FUNCTION | ||
| 24 | |||
| 25 | ! IMPLICIT ARGUMENTS : NONE | ||
| 26 | ! -------------------- | ||
| 27 | |||
| 28 | ! METHOD. | ||
| 29 | ! ------- | ||
| 30 | |||
| 31 | ! TRANSMISSION FUNCTION ARE COMPUTED USING SUMS OF EXPONENTIALS | ||
| 32 | |||
| 33 | ! EXTERNALS. | ||
| 34 | ! ---------- | ||
| 35 | |||
| 36 | ! NONE | ||
| 37 | |||
| 38 | ! REFERENCE. | ||
| 39 | ! ---------- | ||
| 40 | ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND | ||
| 41 | ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS | ||
| 42 | |||
| 43 | ! AUTHOR. | ||
| 44 | ! ------- | ||
| 45 | ! JEAN-JACQUES MORCRETTE *ECMWF* | ||
| 46 | |||
| 47 | ! MODIFICATIONS. | ||
| 48 | ! -------------- | ||
| 49 | ! ORIGINAL : 00-12-18 | ||
| 50 | ! Modified J. HAGUE 03-01-03 MASS Vector Functions | ||
| 51 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
| 52 | |||
| 53 | !----------------------------------------------------------------------- | ||
| 54 | |||
| 55 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
| 56 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
| 57 | |||
| 58 | USE YOESW , ONLY : NEXPO3, REXPO3 | ||
| 59 | USE YOMJFH , ONLY : N_VMASS | ||
| 60 | USE write_field_phy | ||
| 61 | |||
| 62 | IMPLICIT NONE | ||
| 63 | |||
| 64 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
| 65 | INTEGER(KIND=JPIM),INTENT(IN) :: KABS | ||
| 66 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
| 67 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
| 68 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
| 69 | REAL(KIND=JPRB) ,INTENT(IN) :: PU(KLON,KABS) | ||
| 70 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTR(KLON,KABS) | ||
| 71 | !----------------------------------------------------------------------- | ||
| 72 | |||
| 73 | !* 0.1 ARGUMENTS | ||
| 74 | ! --------- | ||
| 75 | |||
| 76 | !----------------------------------------------------------------------- | ||
| 77 | |||
| 78 | ! ------------ | ||
| 79 | |||
| 80 | 56160 | REAL(KIND=JPRB) :: ZU(KLON) | |
| 81 | 56160 | REAL(KIND=JPRB) :: ZTMP1(KFDIA-KIDIA+1+N_VMASS) | |
| 82 | REAL(KIND=JPRB) :: ZTMP2(KFDIA-KIDIA+1+N_VMASS) | ||
| 83 | |||
| 84 | INTEGER(KIND=JPIM) :: JA, JL, IEXP, JX, JLEN | ||
| 85 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
| 86 | LOGICAL LLDEBUG | ||
| 87 | |||
| 88 |
1/2✓ Branch 0 taken 28080 times.
✗ Branch 1 not taken.
|
28080 | IF (LHOOK) CALL DR_HOOK('SWUVO3',0,ZHOOK_HANDLE) |
| 89 | 28080 | IEXP=NEXPO3(KNU) | |
| 90 | LLDEBUG=.FALSE. | ||
| 91 | |||
| 92 | !print *,'Dans SWUVO3, N_VMASS= ',N_VMASS | ||
| 93 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 28080 times.
|
28080 | IF(N_VMASS > 0) THEN |
| 94 | ✗ | JLEN=KFDIA-KIDIA+N_VMASS-MOD(KFDIA-KIDIA,N_VMASS) | |
| 95 | ✗ | IF(KFDIA-KIDIA+1 /= JLEN) THEN | |
| 96 | ✗ | ZTMP1(KFDIA-KIDIA+2:JLEN) = 0.0_JPRB | |
| 97 | ENDIF | ||
| 98 | ENDIF | ||
| 99 | |||
| 100 |
2/2✓ Branch 0 taken 56160 times.
✓ Branch 1 taken 28080 times.
|
84240 | DO JA = 1,KABS |
| 101 |
2/2✓ Branch 0 taken 55823040 times.
✓ Branch 1 taken 56160 times.
|
55879200 | DO JL=KIDIA,KFDIA |
| 102 | 55879200 | PTR(JL,JA)=0.0_JPRB | |
| 103 | ENDDO | ||
| 104 | |||
| 105 | ! Ce qui concerne N_VMASS commente par MPL 20.11.08 | ||
| 106 | ! IF(N_VMASS <= 0) THEN ! Do not use Vector Mass | ||
| 107 | |||
| 108 | ! WRITE(*,'("---> Dans SWUVO3 ")') | ||
| 109 |
2/2✓ Branch 0 taken 374400 times.
✓ Branch 1 taken 56160 times.
|
458640 | DO JX=1,IEXP |
| 110 |
2/2✓ Branch 0 taken 372153600 times.
✓ Branch 1 taken 374400 times.
|
372584160 | DO JL = KIDIA,KFDIA |
| 111 | 372153600 | ZU(JL) = PU(JL,JA) | |
| 112 | 372528000 | PTR(JL,JA) = PTR(JL,JA)+REXPO3(KNU,1,JX)*EXP(-REXPO3(KNU,2,JX)*ZU(JL)) | |
| 113 | ! WRITE(*,'(" PTR ",E12.5)') (PTR(JL,JA)) | ||
| 114 | ! WRITE(*,'("REXPO3-1 ",E12.5)') (REXPO3(KNU,1,JX)) | ||
| 115 | ! WRITE(*,'("REXPO3-2 ",E12.5)') (REXPO3(KNU,2,JX)) | ||
| 116 | ! WRITE(*,'("ZU ",E12.5)') (ZU(JL)) | ||
| 117 | ! WRITE(*,'("KNU KABS IEXP ",3I6)') KNU,KABS,IEXP | ||
| 118 | ENDDO | ||
| 119 | ENDDO | ||
| 120 | |||
| 121 | |||
| 122 | ! ELSE ! Use Vector MASS | ||
| 123 | |||
| 124 | ! DO JX=1,IEXP | ||
| 125 | ! DO JL = KIDIA,KFDIA | ||
| 126 | ! ZTMP1(JL-KIDIA+1)=-REXPO3(KNU,2,JX)*PU(JL,JA) | ||
| 127 | ! ENDDO | ||
| 128 | |||
| 129 | ! CALL VEXP(ZTMP2,ZTMP1,JLEN) | ||
| 130 | |||
| 131 | ! DO JL = KIDIA,KFDIA | ||
| 132 | ! PTR(JL,JA) = PTR(JL,JA)+REXPO3(KNU,1,JX)*ZTMP2(JL-KIDIA+1) | ||
| 133 | ! ENDDO | ||
| 134 | ! ENDDO | ||
| 135 | |||
| 136 | ! ENDIF | ||
| 137 | |||
| 138 | ENDDO | ||
| 139 | |||
| 140 | IF(LLDEBUG) THEN | ||
| 141 | call writefield_phy("swuvo3_pu",pu,kabs) | ||
| 142 | call writefield_phy("swuvo3_ptr",ptr,kabs) | ||
| 143 | ENDIF | ||
| 144 | |||
| 145 |
1/2✓ Branch 0 taken 28080 times.
✗ Branch 1 not taken.
|
28080 | IF (LHOOK) CALL DR_HOOK('SWUVO3',1,ZHOOK_HANDLE) |
| 146 | 28080 | END SUBROUTINE SWUVO3 | |
| 147 |