| Directory: | ./ |
|---|---|
| File: | phy_common/mod_phys_lmdz_mpi_data.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 80 | 80 | 100.0% |
| Branches: | 32 | 56 | 57.1% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | ! | ||
| 2 | !$Id: mod_phys_lmdz_mpi_data.F90 3435 2019-01-22 15:21:59Z fairhead $ | ||
| 3 | ! | ||
| 4 | MODULE mod_phys_lmdz_mpi_data | ||
| 5 | |||
| 6 | INTEGER,SAVE :: ii_begin | ||
| 7 | INTEGER,SAVE :: ii_end | ||
| 8 | INTEGER,SAVE :: jj_begin | ||
| 9 | INTEGER,SAVE :: jj_end | ||
| 10 | INTEGER,SAVE :: jj_nb | ||
| 11 | INTEGER,SAVE :: ij_begin | ||
| 12 | INTEGER,SAVE :: ij_end | ||
| 13 | INTEGER,SAVE :: ij_nb | ||
| 14 | INTEGER,SAVE :: klon_mpi_begin | ||
| 15 | INTEGER,SAVE :: klon_mpi_end | ||
| 16 | INTEGER,SAVE :: klon_mpi | ||
| 17 | |||
| 18 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb | ||
| 19 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin | ||
| 20 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end | ||
| 21 | |||
| 22 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin | ||
| 23 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end | ||
| 24 | |||
| 25 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb | ||
| 26 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin | ||
| 27 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end | ||
| 28 | |||
| 29 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb | ||
| 30 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin | ||
| 31 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end | ||
| 32 | |||
| 33 | |||
| 34 | INTEGER,SAVE :: mpi_rank | ||
| 35 | INTEGER,SAVE :: mpi_size | ||
| 36 | INTEGER,SAVE :: mpi_master | ||
| 37 | LOGICAL,SAVE :: is_mpi_root | ||
| 38 | LOGICAL,SAVE :: is_using_mpi | ||
| 39 | |||
| 40 | |||
| 41 | LOGICAL,SAVE :: is_north_pole_dyn | ||
| 42 | LOGICAL,SAVE :: is_south_pole_dyn | ||
| 43 | INTEGER,SAVE :: COMM_LMDZ_PHY | ||
| 44 | INTEGER,SAVE :: MPI_REAL_LMDZ ! MPI_REAL8 | ||
| 45 | |||
| 46 | CONTAINS | ||
| 47 | |||
| 48 | 1 | SUBROUTINE init_phys_lmdz_mpi_data(nbp, nbp_lon, nbp_lat, communicator) | |
| 49 | IMPLICIT NONE | ||
| 50 | INTEGER,INTENT(IN) :: nbp | ||
| 51 | INTEGER,INTENT(IN) :: nbp_lon | ||
| 52 | INTEGER,INTENT(IN) :: nbp_lat | ||
| 53 | INTEGER,INTENT(IN) :: communicator | ||
| 54 | |||
| 55 | INTEGER,ALLOCATABLE :: distrib(:) | ||
| 56 | INTEGER :: ierr | ||
| 57 | INTEGER :: klon_glo | ||
| 58 | INTEGER :: i | ||
| 59 | |||
| 60 | 1 | is_using_mpi=.FALSE. | |
| 61 | |||
| 62 | 1 | if ((nbp_lon.eq.1).and.(nbp_lat.eq.1)) then ! running 1D column model | |
| 63 | klon_glo=1 | ||
| 64 | else | ||
| 65 | ! The usual global physics grid: 1 point for each pole and nbp_lon points | ||
| 66 | ! for all other latitudes | ||
| 67 | klon_glo=nbp_lon*(nbp_lat-2)+2 | ||
| 68 | endif | ||
| 69 | |||
| 70 | 1 | COMM_LMDZ_PHY=communicator | |
| 71 | |||
| 72 | IF (is_using_mpi) THEN | ||
| 73 | ELSE | ||
| 74 | 1 | mpi_size=1 | |
| 75 | 1 | mpi_rank=0 | |
| 76 | ENDIF | ||
| 77 | |||
| 78 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | ALLOCATE(distrib(0:mpi_size-1)) |
| 79 | |||
| 80 | IF (is_using_mpi) THEN | ||
| 81 | ELSE | ||
| 82 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
|
2 | distrib(:)=nbp |
| 83 | ENDIF | ||
| 84 | |||
| 85 | |||
| 86 | IF (mpi_rank == 0) THEN | ||
| 87 | 1 | mpi_master = 0 | |
| 88 | 1 | is_mpi_root = .true. | |
| 89 | ENDIF | ||
| 90 | |||
| 91 | IF (mpi_rank == 0) THEN | ||
| 92 | 1 | is_north_pole_dyn = .TRUE. | |
| 93 | ELSE | ||
| 94 | is_north_pole_dyn = .FALSE. | ||
| 95 | ENDIF | ||
| 96 | |||
| 97 | IF (mpi_rank == mpi_size-1) THEN | ||
| 98 | 1 | is_south_pole_dyn = .TRUE. | |
| 99 | ELSE | ||
| 100 | is_south_pole_dyn = .FALSE. | ||
| 101 | ENDIF | ||
| 102 | |||
| 103 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(jj_para_nb(0:mpi_size-1)) |
| 104 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(jj_para_begin(0:mpi_size-1)) |
| 105 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(jj_para_end(0:mpi_size-1)) |
| 106 | |||
| 107 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(ij_para_nb(0:mpi_size-1)) |
| 108 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(ij_para_begin(0:mpi_size-1)) |
| 109 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(ij_para_end(0:mpi_size-1)) |
| 110 | |||
| 111 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(ii_para_begin(0:mpi_size-1)) |
| 112 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(ii_para_end(0:mpi_size-1)) |
| 113 | |||
| 114 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(klon_mpi_para_nb(0:mpi_size-1)) |
| 115 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(klon_mpi_para_begin(0:mpi_size-1)) |
| 116 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(klon_mpi_para_end(0:mpi_size-1)) |
| 117 | |||
| 118 | |||
| 119 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
|
2 | klon_mpi_para_nb(0:mpi_size-1)=distrib(0:mpi_size-1) |
| 120 | |||
| 121 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
|
2 | DO i=0,mpi_size-1 |
| 122 | IF (i==0) THEN | ||
| 123 | 1 | klon_mpi_para_begin(i)=1 | |
| 124 | ELSE | ||
| 125 | klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1 | ||
| 126 | ENDIF | ||
| 127 | 2 | klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1 | |
| 128 | ENDDO | ||
| 129 | |||
| 130 | |||
| 131 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
|
2 | DO i=0,mpi_size-1 |
| 132 | |||
| 133 | IF (i==0) THEN | ||
| 134 | 1 | ij_para_begin(i) = 1 | |
| 135 | ELSE | ||
| 136 | ij_para_begin(i) = klon_mpi_para_begin(i)+nbp_lon-1 | ||
| 137 | ENDIF | ||
| 138 | |||
| 139 | 1 | jj_para_begin(i) = (ij_para_begin(i)-1)/nbp_lon + 1 | |
| 140 | 1 | ii_para_begin(i) = MOD(ij_para_begin(i)-1,nbp_lon) + 1 | |
| 141 | |||
| 142 | |||
| 143 | 1 | ij_para_end(i) = klon_mpi_para_end(i)+nbp_lon-1 | |
| 144 | 1 | jj_para_end(i) = (ij_para_end(i)-1)/nbp_lon + 1 | |
| 145 | 1 | ii_para_end(i) = MOD(ij_para_end(i)-1,nbp_lon) + 1 | |
| 146 | |||
| 147 | |||
| 148 | 1 | ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1 | |
| 149 | 2 | jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1 | |
| 150 | |||
| 151 | ENDDO | ||
| 152 | |||
| 153 | 1 | ii_begin = ii_para_begin(mpi_rank) | |
| 154 | 1 | ii_end = ii_para_end(mpi_rank) | |
| 155 | 1 | jj_begin = jj_para_begin(mpi_rank) | |
| 156 | 1 | jj_end = jj_para_end(mpi_rank) | |
| 157 | 1 | jj_nb = jj_para_nb(mpi_rank) | |
| 158 | 1 | ij_begin = ij_para_begin(mpi_rank) | |
| 159 | 1 | ij_end = ij_para_end(mpi_rank) | |
| 160 | 1 | ij_nb = ij_para_nb(mpi_rank) | |
| 161 | 1 | klon_mpi_begin = klon_mpi_para_begin(mpi_rank) | |
| 162 | 1 | klon_mpi_end = klon_mpi_para_end(mpi_rank) | |
| 163 | 1 | klon_mpi = klon_mpi_para_nb(mpi_rank) | |
| 164 | |||
| 165 | 1 | CALL Print_module_data | |
| 166 | |||
| 167 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | END SUBROUTINE Init_phys_lmdz_mpi_data |
| 168 | |||
| 169 | 1 | SUBROUTINE print_module_data | |
| 170 | USE print_control_mod, ONLY: lunout | ||
| 171 | IMPLICIT NONE | ||
| 172 | ! INCLUDE "iniprint.h" | ||
| 173 | |||
| 174 | 1 | WRITE(lunout,*) 'ii_begin =', ii_begin | |
| 175 | 1 | WRITE(lunout,*) 'ii_end =', ii_end | |
| 176 | 1 | WRITE(lunout,*) 'jj_begin =',jj_begin | |
| 177 | 1 | WRITE(lunout,*) 'jj_end =', jj_end | |
| 178 | 1 | WRITE(lunout,*) 'jj_nb =', jj_nb | |
| 179 | 1 | WRITE(lunout,*) 'ij_begin =', ij_begin | |
| 180 | 1 | WRITE(lunout,*) 'ij_end =', ij_end | |
| 181 | 1 | WRITE(lunout,*) 'ij_nb =', ij_nb | |
| 182 | 1 | WRITE(lunout,*) 'klon_mpi_begin =', klon_mpi_begin | |
| 183 | 1 | WRITE(lunout,*) 'klon_mpi_end =', klon_mpi_end | |
| 184 | 1 | WRITE(lunout,*) 'klon_mpi =', klon_mpi | |
| 185 | 1 | WRITE(lunout,*) 'jj_para_nb =', jj_para_nb | |
| 186 | 1 | WRITE(lunout,*) 'jj_para_begin =', jj_para_begin | |
| 187 | 1 | WRITE(lunout,*) 'jj_para_end =', jj_para_end | |
| 188 | 1 | WRITE(lunout,*) 'ii_para_begin =', ii_para_begin | |
| 189 | 1 | WRITE(lunout,*) 'ii_para_end =', ii_para_end | |
| 190 | 1 | WRITE(lunout,*) 'ij_para_nb =', ij_para_nb | |
| 191 | 1 | WRITE(lunout,*) 'ij_para_begin =', ij_para_begin | |
| 192 | 1 | WRITE(lunout,*) 'ij_para_end =', ij_para_end | |
| 193 | 1 | WRITE(lunout,*) 'klon_mpi_para_nb =', klon_mpi_para_nb | |
| 194 | 1 | WRITE(lunout,*) 'klon_mpi_para_begin =', klon_mpi_para_begin | |
| 195 | 1 | WRITE(lunout,*) 'klon_mpi_para_end =', klon_mpi_para_end | |
| 196 | 1 | WRITE(lunout,*) 'mpi_rank =', mpi_rank | |
| 197 | 1 | WRITE(lunout,*) 'mpi_size =', mpi_size | |
| 198 | 1 | WRITE(lunout,*) 'mpi_master =', mpi_master | |
| 199 | 1 | WRITE(lunout,*) 'is_mpi_root =', is_mpi_root | |
| 200 | 1 | WRITE(lunout,*) 'is_north_pole =', is_north_pole_dyn | |
| 201 | 1 | WRITE(lunout,*) 'is_south_pole =', is_south_pole_dyn | |
| 202 | 1 | WRITE(lunout,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY | |
| 203 | |||
| 204 | 1 | END SUBROUTINE print_module_data | |
| 205 | |||
| 206 | END MODULE mod_phys_lmdz_mpi_data | ||
| 207 |