| Directory: | ./ |
|---|---|
| File: | phys/change_srf_frac_mod.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 24 | 35 | 68.6% |
| Branches: | 106 | 150 | 70.7% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | ! | ||
| 2 | ! $Id: change_srf_frac_mod.F90 3780 2020-10-22 12:50:18Z evignon $ | ||
| 3 | ! | ||
| 4 | MODULE change_srf_frac_mod | ||
| 5 | |||
| 6 | IMPLICIT NONE | ||
| 7 | |||
| 8 | CONTAINS | ||
| 9 | ! | ||
| 10 | ! Change Surface Fractions | ||
| 11 | ! Author J Ghattas 2008 | ||
| 12 | |||
| 13 | 480 | SUBROUTINE change_srf_frac(itime, dtime, jour, & | |
| 14 | 480 | pctsrf, evap, z0m, z0h, agesno, & | |
| 15 | alb_dir, alb_dif, tsurf, ustar, u10m, v10m, pbl_tke) | ||
| 16 | |||
| 17 | |||
| 18 | |||
| 19 | ! | ||
| 20 | ! This subroutine is called from physiq.F at each timestep. | ||
| 21 | ! 1- For each type of ocean (force, slab, couple) receive new fractions only if | ||
| 22 | ! it's time to modify (is_modified=true). Otherwise nothing is done (is_modified=false). | ||
| 23 | ! If received new fraction : | ||
| 24 | ! 2- Tests and ajustements are done on the fractions | ||
| 25 | ! 3- Initialize variables where a new fraction(new or melted ice) has appered, | ||
| 26 | ! | ||
| 27 | |||
| 28 | USE dimphy | ||
| 29 | USE surface_data, ONLY : type_ocean,version_ocean | ||
| 30 | USE limit_read_mod | ||
| 31 | USE pbl_surface_mod, ONLY : pbl_surface_newfrac | ||
| 32 | USE cpl_mod, ONLY : cpl_receive_frac | ||
| 33 | USE ocean_slab_mod, ONLY : fsic, ocean_slab_frac | ||
| 34 | USE indice_sol_mod | ||
| 35 | USE print_control_mod, ONLY: lunout | ||
| 36 | |||
| 37 | INCLUDE "YOMCST.h" | ||
| 38 | !albedo SB >>> | ||
| 39 | include "clesphys.h" | ||
| 40 | !albedo SB <<< | ||
| 41 | |||
| 42 | |||
| 43 | |||
| 44 | ! Input arguments | ||
| 45 | !**************************************************************************************** | ||
| 46 | INTEGER, INTENT(IN) :: itime ! current time step | ||
| 47 | INTEGER, INTENT(IN) :: jour ! day of the year | ||
| 48 | REAL, INTENT(IN) :: dtime ! length of time step (s) | ||
| 49 | |||
| 50 | ! In-Output arguments | ||
| 51 | !**************************************************************************************** | ||
| 52 | |||
| 53 | REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf ! sub-surface fraction | ||
| 54 | REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: evap, agesno ! sub-surface fraction | ||
| 55 | REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT) :: z0m,z0h ! sub-surface fraction | ||
| 56 | !albedo SB >>> | ||
| 57 | REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT) :: alb_dir,alb_dif | ||
| 58 | !albedo SB <<< | ||
| 59 | |||
| 60 | REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: tsurf | ||
| 61 | REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: ustar | ||
| 62 | REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: u10m | ||
| 63 | REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: v10m | ||
| 64 | !jyg< | ||
| 65 | !! REAL, DIMENSION(klon,klev+1,nbsrf), INTENT(INOUT) :: pbl_tke | ||
| 66 | REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: pbl_tke | ||
| 67 | !>jyg | ||
| 68 | |||
| 69 | ! Loccal variables | ||
| 70 | !**************************************************************************************** | ||
| 71 | INTEGER :: i, nsrf | ||
| 72 | LOGICAL :: is_modified ! true if pctsrf is modified at this time step | ||
| 73 | LOGICAL :: test_sum=.FALSE. | ||
| 74 | LOGICAL, DIMENSION(klon,nbsrf) :: new_surf | ||
| 75 | 480 | REAL, DIMENSION(klon,nbsrf) :: pctsrf_old ! fraction from previous time-step | |
| 76 | REAL :: tmpsum | ||
| 77 | |||
| 78 |
4/4✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 1908480 times.
✓ Branch 3 taken 1920 times.
|
1910880 | pctsrf_old(:,:) = pctsrf(:,:) |
| 79 | !**************************************************************************************** | ||
| 80 | ! 1) | ||
| 81 | ! For each type of ocean (force, slab, couple) receive new fractions only if it's time | ||
| 82 | ! to modify (is_modified=true). Otherwise nothing is done (is_modified=false). | ||
| 83 | !**************************************************************************************** | ||
| 84 | 480 | SELECT CASE (type_ocean) | |
| 85 | CASE ('force') | ||
| 86 | ! Read fraction from limit.nc | ||
| 87 | 480 | CALL limit_read_frac(itime, dtime, jour, pctsrf, is_modified) | |
| 88 | CASE ('slab') | ||
| 89 | ✗ | IF (version_ocean == 'sicOBS'.OR. version_ocean == 'sicNO') THEN | |
| 90 | ! Read fraction from limit.nc | ||
| 91 | ✗ | CALL limit_read_frac(itime, dtime, jour, pctsrf, is_modified) | |
| 92 | ELSE | ||
| 93 | ! Get fraction from slab module | ||
| 94 | ✗ | CALL ocean_slab_frac(itime, dtime, jour, pctsrf, is_modified) | |
| 95 | ENDIF | ||
| 96 | CASE ('couple') | ||
| 97 | ! Get fraction from the coupler | ||
| 98 |
1/4✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
480 | CALL cpl_receive_frac(itime, dtime, pctsrf, is_modified) |
| 99 | END SELECT | ||
| 100 | |||
| 101 | |||
| 102 | !**************************************************************************************** | ||
| 103 | ! 2) | ||
| 104 | ! Tests and ajustements on the new fractions : | ||
| 105 | ! - Put to zero fractions that are too small | ||
| 106 | ! - Test total fraction sum is one for each grid point | ||
| 107 | ! | ||
| 108 | !**************************************************************************************** | ||
| 109 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 470 times.
|
480 | IF (is_modified) THEN |
| 110 | |||
| 111 | ! Test and exit if a fraction is negative | ||
| 112 |
10/16✓ Branch 0 taken 40 times.
✓ Branch 1 taken 10 times.
✓ Branch 2 taken 39760 times.
✓ Branch 3 taken 40 times.
✓ Branch 4 taken 39750 times.
✓ Branch 5 taken 10 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 39750 times.
✓ Branch 8 taken 10 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 10 times.
✗ Branch 12 not taken.
✗ Branch 13 not taken.
✗ Branch 14 not taken.
✓ Branch 15 taken 10 times.
|
39810 | IF (MINVAL(pctsrf(:,:)) < 0.) THEN |
| 113 | ✗ | WRITE(lunout,*)'Warning! One or several fractions are negative, itime=',itime | |
| 114 | ✗ | WRITE(lunout,*)'at point = ',MINLOC(pctsrf(:,:)) | |
| 115 | ✗ | WRITE(lunout,*)'value = ',MINVAL(pctsrf(:,:)) | |
| 116 | ✗ | CALL abort_physic('change_srf_frac','Negative fraction',1) | |
| 117 | END IF | ||
| 118 | |||
| 119 | ! Optional test on the incoming fraction | ||
| 120 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 10 times.
|
10 | IF (test_sum) THEN |
| 121 | ✗ | DO i= 1, klon | |
| 122 | ✗ | tmpsum = SUM(pctsrf(i,:)) | |
| 123 | ✗ | IF (ABS(1. - tmpsum) > 0.05) CALL abort_physic('change_srf_frac','Total fraction not equal 1.',1) | |
| 124 | END DO | ||
| 125 | END IF | ||
| 126 | |||
| 127 | ! Test for too small fractions of the sum land+landice and ocean+sea-ice | ||
| 128 |
10/10✓ Branch 0 taken 9940 times.
✓ Branch 1 taken 10 times.
✓ Branch 2 taken 9940 times.
✓ Branch 3 taken 10 times.
✓ Branch 4 taken 3910 times.
✓ Branch 5 taken 6030 times.
✓ Branch 6 taken 9940 times.
✓ Branch 7 taken 10 times.
✓ Branch 8 taken 3910 times.
✓ Branch 9 taken 6030 times.
|
29830 | WHERE ((pctsrf(:,is_ter) + pctsrf(:,is_lic)) < 2*EPSFRA) |
| 129 | pctsrf(:,is_ter) = 0. | ||
| 130 | pctsrf(:,is_lic) = 0. | ||
| 131 | END WHERE | ||
| 132 | |||
| 133 |
10/10✓ Branch 0 taken 9940 times.
✓ Branch 1 taken 10 times.
✓ Branch 2 taken 9940 times.
✓ Branch 3 taken 10 times.
✓ Branch 4 taken 1620 times.
✓ Branch 5 taken 8320 times.
✓ Branch 6 taken 9940 times.
✓ Branch 7 taken 10 times.
✓ Branch 8 taken 1620 times.
✓ Branch 9 taken 8320 times.
|
29830 | WHERE ((pctsrf(:,is_oce) + pctsrf(:,is_sic)) < 2*EPSFRA) |
| 134 | pctsrf(:,is_oce) = 0. | ||
| 135 | pctsrf(:,is_sic) = 0. | ||
| 136 | END WHERE | ||
| 137 | |||
| 138 | ! Normalize to force total fraction to be equal one | ||
| 139 |
2/2✓ Branch 0 taken 9940 times.
✓ Branch 1 taken 10 times.
|
9950 | DO i= 1, klon |
| 140 |
2/2✓ Branch 0 taken 9940 times.
✓ Branch 1 taken 39760 times.
|
49700 | tmpsum = SUM(pctsrf(i,:)) |
| 141 |
2/2✓ Branch 0 taken 39760 times.
✓ Branch 1 taken 9940 times.
|
49710 | DO nsrf = 1, nbsrf |
| 142 | 49700 | pctsrf(i,nsrf) = pctsrf(i,nsrf) / tmpsum | |
| 143 | END DO | ||
| 144 | END DO | ||
| 145 | |||
| 146 | ! Test for too small fractions at each sub-surface | ||
| 147 |
15/16✓ Branch 0 taken 9940 times.
✓ Branch 1 taken 10 times.
✓ Branch 2 taken 10 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9940 times.
✓ Branch 5 taken 10 times.
✓ Branch 6 taken 4780 times.
✓ Branch 7 taken 5160 times.
✓ Branch 8 taken 9940 times.
✓ Branch 9 taken 10 times.
✓ Branch 10 taken 4780 times.
✓ Branch 11 taken 5160 times.
✓ Branch 12 taken 9940 times.
✓ Branch 13 taken 10 times.
✓ Branch 14 taken 4780 times.
✓ Branch 15 taken 5160 times.
|
39770 | WHERE (pctsrf(:,is_ter) < EPSFRA) |
| 148 | pctsrf(:,is_lic) = pctsrf(:,is_ter) + pctsrf(:,is_lic) | ||
| 149 | pctsrf(:,is_ter) = 0. | ||
| 150 | END WHERE | ||
| 151 | |||
| 152 |
14/14✓ Branch 0 taken 9940 times.
✓ Branch 1 taken 10 times.
✓ Branch 2 taken 9940 times.
✓ Branch 3 taken 10 times.
✓ Branch 4 taken 8420 times.
✓ Branch 5 taken 1520 times.
✓ Branch 6 taken 9940 times.
✓ Branch 7 taken 10 times.
✓ Branch 8 taken 8420 times.
✓ Branch 9 taken 1520 times.
✓ Branch 10 taken 9940 times.
✓ Branch 11 taken 10 times.
✓ Branch 12 taken 8420 times.
✓ Branch 13 taken 1520 times.
|
39770 | WHERE (pctsrf(:,is_lic) < EPSFRA) |
| 153 | pctsrf(:,is_ter) = pctsrf(:,is_ter) + pctsrf(:,is_lic) | ||
| 154 | pctsrf(:,is_lic) = 0. | ||
| 155 | END WHERE | ||
| 156 | |||
| 157 |
14/14✓ Branch 0 taken 9940 times.
✓ Branch 1 taken 10 times.
✓ Branch 2 taken 9940 times.
✓ Branch 3 taken 10 times.
✓ Branch 4 taken 2377 times.
✓ Branch 5 taken 7563 times.
✓ Branch 6 taken 9940 times.
✓ Branch 7 taken 10 times.
✓ Branch 8 taken 2377 times.
✓ Branch 9 taken 7563 times.
✓ Branch 10 taken 9940 times.
✓ Branch 11 taken 10 times.
✓ Branch 12 taken 2377 times.
✓ Branch 13 taken 7563 times.
|
39770 | WHERE (pctsrf(:,is_oce) < EPSFRA) |
| 158 | pctsrf(:,is_sic) = pctsrf(:,is_oce) + pctsrf(:,is_sic) | ||
| 159 | pctsrf(:,is_oce) = 0. | ||
| 160 | END WHERE | ||
| 161 | |||
| 162 |
14/14✓ Branch 0 taken 9940 times.
✓ Branch 1 taken 10 times.
✓ Branch 2 taken 9940 times.
✓ Branch 3 taken 10 times.
✓ Branch 4 taken 7753 times.
✓ Branch 5 taken 2187 times.
✓ Branch 6 taken 9940 times.
✓ Branch 7 taken 10 times.
✓ Branch 8 taken 7753 times.
✓ Branch 9 taken 2187 times.
✓ Branch 10 taken 9940 times.
✓ Branch 11 taken 10 times.
✓ Branch 12 taken 7753 times.
✓ Branch 13 taken 2187 times.
|
39770 | WHERE (pctsrf(:,is_sic) < EPSFRA) |
| 163 | pctsrf(:,is_oce) = pctsrf(:,is_oce) + pctsrf(:,is_sic) | ||
| 164 | pctsrf(:,is_sic) = 0. | ||
| 165 | END WHERE | ||
| 166 | ! Send fractions back to slab ocean if needed | ||
| 167 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 10 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
10 | IF (type_ocean == 'slab'.AND. version_ocean.NE.'sicINT') THEN |
| 168 | ✗ | WHERE (1.-zmasq(:)>EPSFRA) | |
| 169 | fsic(:)=pctsrf(:,is_sic)/(1.-zmasq(:)) | ||
| 170 | END WHERE | ||
| 171 | END IF | ||
| 172 | |||
| 173 | !**************************************************************************************** | ||
| 174 | ! 3) | ||
| 175 | ! Initialize variables where a new fraction has appered, | ||
| 176 | ! i.e. where new sea ice has been formed | ||
| 177 | ! or where ice free ocean has appread in a grid cell | ||
| 178 | ! | ||
| 179 | !**************************************************************************************** | ||
| 180 | |||
| 181 | CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, & | ||
| 182 | evap, z0m, z0h, agesno, & | ||
| 183 | 10 | tsurf, alb_dir,alb_dif, ustar, u10m, v10m, pbl_tke) | |
| 184 | |||
| 185 | ELSE | ||
| 186 | ! No modifcation should be done | ||
| 187 |
4/4✓ Branch 0 taken 1880 times.
✓ Branch 1 taken 470 times.
✓ Branch 2 taken 1868720 times.
✓ Branch 3 taken 1880 times.
|
1871070 | pctsrf(:,:) = pctsrf_old(:,:) |
| 188 | |||
| 189 | END IF ! is_modified | ||
| 190 | |||
| 191 | 480 | END SUBROUTINE change_srf_frac | |
| 192 | |||
| 193 | |||
| 194 | END MODULE change_srf_frac_mod | ||
| 195 |