[3491] | 1 | !!!! Abderrahmane Idelkadi aout 2013 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 2 | ! Module pour definir (au 1er appel) et ecrire les variables dans les fichiers de sortie cosp |
---|
| 3 | ! |
---|
| 4 | ! R.Guzman jan 2019 (mise a jour pour COSPv2) |
---|
| 5 | ! On change le nom du module a "lmdz_cosp_output_write_mod" et celui de la routine a "lmdz_cosp_output_write" |
---|
| 6 | ! pour qu on sache qu il s agit d un module specifique a l implementation de COSP dans LMDZ |
---|
| 7 | ! |
---|
| 8 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 9 | MODULE lmdz_cosp_output_write_mod |
---|
| 10 | |
---|
| 11 | USE lmdz_cosp_output_mod |
---|
| 12 | USE mod_cosp_config, only : R_UNDEF, CLOUDSAT_DBZE_BINS, SR_BINS, PARASOL_NREFL, & |
---|
| 13 | isccp_histPresCenters,tau_binCenters, LIDAR_NTEMP, & |
---|
| 14 | LIDAR_PHASE_TEMP,misr_histHgtCenters,numMISRHgtBins, & |
---|
| 15 | numMODISReffIceBins,reffICE_binCenters, & |
---|
| 16 | numMODISReffLiqBins, reffLIQ_binCenters |
---|
| 17 | |
---|
| 18 | IMPLICIT NONE |
---|
| 19 | |
---|
| 20 | INTEGER, SAVE :: itau_iocosp |
---|
| 21 | !$OMP THREADPRIVATE(itau_iocosp) |
---|
| 22 | INTEGER, save :: Nlevout, Ncolout |
---|
| 23 | !$OMP THREADPRIVATE(Nlevout, Ncolout) |
---|
| 24 | |
---|
| 25 | ! INTERFACE histwrite_cosp |
---|
| 26 | ! MODULE PROCEDURE histwrite2d_cosp,histwrite3d_cosp |
---|
| 27 | ! END INTERFACE |
---|
| 28 | |
---|
| 29 | CONTAINS |
---|
| 30 | |
---|
| 31 | SUBROUTINE lmdz_cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, missing_cosp, & |
---|
[3723] | 32 | cfg, Nlvgrid, cospOUT) |
---|
[3491] | 33 | |
---|
| 34 | |
---|
| 35 | USE ioipsl |
---|
| 36 | USE time_phylmdz_mod, ONLY: itau_phy, start_time, day_step_phy |
---|
| 37 | USE print_control_mod, ONLY: lunout,prt_level |
---|
| 38 | USE lmdz_cosp_read_outputkeys, only: cosp_config |
---|
| 39 | !COSPv2 |
---|
| 40 | use cosp_kinds, only: wp |
---|
| 41 | use mod_cosp, only: cosp_outputs |
---|
| 42 | |
---|
| 43 | USE wxios, only: wxios_closedef |
---|
[4727] | 44 | USE lmdz_xios, only: xios_update_calendar, xios_field_is_active |
---|
[3491] | 45 | IMPLICIT NONE |
---|
| 46 | !!! Variables d'entree |
---|
| 47 | integer :: itap, Nlevlmdz, Ncolumns, Npoints, Nlvgrid |
---|
| 48 | real :: freq_COSP, dtime, missing_val, missing_cosp |
---|
| 49 | type(cosp_config) :: cfg ! Control outputs |
---|
| 50 | type(cosp_outputs) :: & |
---|
| 51 | cospOUT ! COSP simulator outputs |
---|
| 52 | |
---|
| 53 | |
---|
| 54 | !!! Variables locales |
---|
| 55 | integer :: icl,k,ip |
---|
| 56 | logical :: ok_sync |
---|
| 57 | integer :: itau_wcosp, iff |
---|
| 58 | real, dimension(Npoints,PARASOL_NREFL) :: parasolcrefl, Ncref |
---|
| 59 | |
---|
| 60 | ! Variables locals intermidiaires pour inverser les axes des champs 4D |
---|
| 61 | ! Compatibilite avec sorties CMIP |
---|
[3723] | 62 | real, dimension(Npoints,Nlvgrid,SR_BINS) :: tmp_fi4da_cfadL, tmp_fi4da_cfadLgr, tmp_fi4da_cfadLatlid |
---|
| 63 | real, dimension(Npoints,Nlvgrid,CLOUDSAT_DBZE_BINS) :: tmp_fi4da_cfadR |
---|
[3491] | 64 | real, dimension(Npoints,numMISRHgtBins,7) :: tmp_fi4da_misr |
---|
| 65 | |
---|
| 66 | missing_val=missing_cosp |
---|
| 67 | |
---|
| 68 | Nlevout = Nlvgrid |
---|
| 69 | Ncolout = Ncolumns |
---|
| 70 | |
---|
| 71 | ! A refaire |
---|
| 72 | itau_wcosp = itau_phy + itap + start_time * day_step_phy |
---|
| 73 | if (prt_level >= 10) then |
---|
| 74 | WRITE(lunout,*)'itau_wcosp, itap, start_time, day_step_phy =', & |
---|
| 75 | itau_wcosp, itap, start_time, day_step_phy |
---|
| 76 | endif |
---|
| 77 | |
---|
| 78 | ! On le donne a cosp_output_write_mod pour que les histwrite y aient acces: |
---|
| 79 | CALL set_itau_iocosp(itau_wcosp) |
---|
| 80 | if (prt_level >= 10) then |
---|
| 81 | WRITE(lunout,*)'itau_iocosp =',itau_iocosp |
---|
| 82 | endif |
---|
| 83 | |
---|
| 84 | ok_sync = .TRUE. |
---|
| 85 | |
---|
| 86 | !!!! Sorties Calipso |
---|
| 87 | if (cfg%Lcalipso) then |
---|
| 88 | |
---|
| 89 | ! print*,'Appel histwrite2d_cosp' |
---|
[3723] | 90 | if (cfg%Lcllcalipso) then |
---|
| 91 | where(cospOUT%calipso_cldlayer(:,1) == R_UNDEF) cospOUT%calipso_cldlayer(:,1) = missing_val |
---|
| 92 | CALL histwrite2d_cosp(o_cllcalipso,cospOUT%calipso_cldlayer(:,1)) |
---|
| 93 | endif |
---|
| 94 | if (cfg%Lclhcalipso) then |
---|
| 95 | where(cospOUT%calipso_cldlayer(:,3) == R_UNDEF) cospOUT%calipso_cldlayer(:,3) = missing_val |
---|
| 96 | CALL histwrite2d_cosp(o_clhcalipso,cospOUT%calipso_cldlayer(:,3)) |
---|
| 97 | endif |
---|
| 98 | if (cfg%Lclmcalipso) then |
---|
| 99 | where(cospOUT%calipso_cldlayer(:,2) == R_UNDEF) cospOUT%calipso_cldlayer(:,2) = missing_val |
---|
| 100 | CALL histwrite2d_cosp(o_clmcalipso,cospOUT%calipso_cldlayer(:,2)) |
---|
| 101 | endif |
---|
| 102 | if (cfg%Lcltcalipso) then |
---|
| 103 | where(cospOUT%calipso_cldlayer(:,4) == R_UNDEF) cospOUT%calipso_cldlayer(:,4) = missing_val |
---|
| 104 | CALL histwrite2d_cosp(o_cltcalipso,cospOUT%calipso_cldlayer(:,4)) |
---|
| 105 | endif |
---|
| 106 | if (cfg%Lclcalipso) then |
---|
| 107 | where(cospOUT%calipso_lidarcld == R_UNDEF) cospOUT%calipso_lidarcld = missing_val |
---|
| 108 | CALL histwrite3d_cosp(o_clcalipso,cospOUT%calipso_lidarcld,nvert) |
---|
| 109 | endif |
---|
| 110 | if (cfg%Lclcalipsotmp) then |
---|
| 111 | where(cospOUT%calipso_lidarcldtmp(:,:,1) == R_UNDEF) cospOUT%calipso_lidarcldtmp(:,:,1) = missing_val |
---|
| 112 | CALL histwrite3d_cosp(o_clcalipsotmp,cospOUT%calipso_lidarcldtmp(:,:,1),nverttemp) |
---|
| 113 | endif |
---|
[3491] | 114 | |
---|
[3723] | 115 | if (cfg%Lcllcalipsoice) then |
---|
| 116 | where(cospOUT%calipso_cldlayerphase(:,1,1) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,1,1) = missing_val |
---|
| 117 | CALL histwrite2d_cosp(o_cllcalipsoice,cospOUT%calipso_cldlayerphase(:,1,1)) |
---|
| 118 | endif |
---|
| 119 | if (cfg%Lclhcalipsoice) then |
---|
| 120 | where(cospOUT%calipso_cldlayerphase(:,3,1) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,3,1) = missing_val |
---|
| 121 | CALL histwrite2d_cosp(o_clhcalipsoice,cospOUT%calipso_cldlayerphase(:,3,1)) |
---|
| 122 | endif |
---|
| 123 | if (cfg%Lclmcalipsoice) then |
---|
| 124 | where(cospOUT%calipso_cldlayerphase(:,2,1) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,2,1) = missing_val |
---|
| 125 | CALL histwrite2d_cosp(o_clmcalipsoice,cospOUT%calipso_cldlayerphase(:,2,1)) |
---|
| 126 | endif |
---|
| 127 | if (cfg%Lcltcalipsoice) then |
---|
| 128 | where(cospOUT%calipso_cldlayerphase(:,4,1) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,4,1) = missing_val |
---|
| 129 | CALL histwrite2d_cosp(o_cltcalipsoice,cospOUT%calipso_cldlayerphase(:,4,1)) |
---|
| 130 | endif |
---|
| 131 | if (cfg%Lclcalipsoice) then |
---|
| 132 | where(cospOUT%calipso_lidarcldphase(:,:,1) == R_UNDEF) cospOUT%calipso_lidarcldphase(:,:,1) = missing_val |
---|
| 133 | CALL histwrite3d_cosp(o_clcalipsoice,cospOUT%calipso_lidarcldphase(:,:,1),nvert) |
---|
| 134 | endif |
---|
| 135 | if (cfg%Lclcalipsotmpice) then |
---|
| 136 | where(cospOUT%calipso_lidarcldtmp(:,:,2) == R_UNDEF) cospOUT%calipso_lidarcldtmp(:,:,2) = missing_val |
---|
| 137 | CALL histwrite3d_cosp(o_clcalipsotmpice,cospOUT%calipso_lidarcldtmp(:,:,2),nverttemp) |
---|
| 138 | endif |
---|
[3491] | 139 | |
---|
[3723] | 140 | if (cfg%Lcllcalipsoliq) then |
---|
| 141 | where(cospOUT%calipso_cldlayerphase(:,1,2) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,1,2) = missing_val |
---|
| 142 | CALL histwrite2d_cosp(o_cllcalipsoliq,cospOUT%calipso_cldlayerphase(:,1,2)) |
---|
| 143 | endif |
---|
| 144 | if (cfg%Lclhcalipsoliq) then |
---|
| 145 | where(cospOUT%calipso_cldlayerphase(:,3,2) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,3,2) = missing_val |
---|
| 146 | CALL histwrite2d_cosp(o_clhcalipsoliq,cospOUT%calipso_cldlayerphase(:,3,2)) |
---|
| 147 | endif |
---|
| 148 | if (cfg%Lclmcalipsoliq) then |
---|
| 149 | where(cospOUT%calipso_cldlayerphase(:,2,2) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,2,2) = missing_val |
---|
| 150 | CALL histwrite2d_cosp(o_clmcalipsoliq,cospOUT%calipso_cldlayerphase(:,2,2)) |
---|
| 151 | endif |
---|
| 152 | if (cfg%Lcltcalipsoliq) then |
---|
| 153 | where(cospOUT%calipso_cldlayerphase(:,4,2) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,4,2) = missing_val |
---|
| 154 | CALL histwrite2d_cosp(o_cltcalipsoliq,cospOUT%calipso_cldlayerphase(:,4,2)) |
---|
| 155 | endif |
---|
| 156 | if (cfg%Lclcalipsoliq) then |
---|
| 157 | where(cospOUT%calipso_lidarcldphase(:,:,2) == R_UNDEF) cospOUT%calipso_lidarcldphase(:,:,2) = missing_val |
---|
| 158 | CALL histwrite3d_cosp(o_clcalipsoliq,cospOUT%calipso_lidarcldphase(:,:,2),nvert) |
---|
| 159 | endif |
---|
| 160 | if (cfg%Lclcalipsotmpliq) then |
---|
| 161 | where(cospOUT%calipso_lidarcldtmp(:,:,3) == R_UNDEF) cospOUT%calipso_lidarcldtmp(:,:,3) = missing_val |
---|
| 162 | CALL histwrite3d_cosp(o_clcalipsotmpliq,cospOUT%calipso_lidarcldtmp(:,:,3),nverttemp) |
---|
| 163 | endif |
---|
| 164 | if (cfg%Lcllcalipsoun) then |
---|
| 165 | where(cospOUT%calipso_cldlayerphase(:,1,3) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,1,3) = missing_val |
---|
| 166 | CALL histwrite2d_cosp(o_cllcalipsoun,cospOUT%calipso_cldlayerphase(:,1,3)) |
---|
| 167 | endif |
---|
| 168 | if (cfg%Lclhcalipsoun) then |
---|
| 169 | where(cospOUT%calipso_cldlayerphase(:,3,3) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,3,3) = missing_val |
---|
| 170 | CALL histwrite2d_cosp(o_clhcalipsoun,cospOUT%calipso_cldlayerphase(:,3,3)) |
---|
| 171 | endif |
---|
| 172 | if (cfg%Lclmcalipsoun) then |
---|
| 173 | where(cospOUT%calipso_cldlayerphase(:,2,3) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,2,3) = missing_val |
---|
| 174 | CALL histwrite2d_cosp(o_clmcalipsoun,cospOUT%calipso_cldlayerphase(:,2,3)) |
---|
| 175 | endif |
---|
| 176 | if (cfg%Lcltcalipsoun) then |
---|
| 177 | where(cospOUT%calipso_cldlayerphase(:,4,3) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,4,3) = missing_val |
---|
| 178 | CALL histwrite2d_cosp(o_cltcalipsoun,cospOUT%calipso_cldlayerphase(:,4,3)) |
---|
| 179 | endif |
---|
| 180 | if (cfg%Lclcalipsoun) then |
---|
| 181 | where(cospOUT%calipso_lidarcldphase(:,:,3) == R_UNDEF) cospOUT%calipso_lidarcldphase(:,:,3) = missing_val |
---|
| 182 | CALL histwrite3d_cosp(o_clcalipsoun,cospOUT%calipso_lidarcldphase(:,:,3),nvert) |
---|
| 183 | endif |
---|
| 184 | if (cfg%Lclcalipsotmpun) then |
---|
| 185 | where(cospOUT%calipso_lidarcldtmp(:,:,4) == R_UNDEF) cospOUT%calipso_lidarcldtmp(:,:,4) = missing_val |
---|
| 186 | CALL histwrite3d_cosp(o_clcalipsotmpun,cospOUT%calipso_lidarcldtmp(:,:,4),nverttemp) |
---|
| 187 | endif |
---|
[3491] | 188 | |
---|
[3723] | 189 | if (cfg%Lclopaquecalipso) then |
---|
| 190 | where(cospOUT%calipso_cldtype(:,1) == R_UNDEF) cospOUT%calipso_cldtype(:,1) = missing_val |
---|
| 191 | CALL histwrite2d_cosp(o_clopaquecalipso,cospOUT%calipso_cldtype(:,1)) |
---|
| 192 | endif |
---|
| 193 | if (cfg%Lclthincalipso) then |
---|
| 194 | where(cospOUT%calipso_cldtype(:,2) == R_UNDEF) cospOUT%calipso_cldtype(:,2) = missing_val |
---|
| 195 | CALL histwrite2d_cosp(o_clthincalipso,cospOUT%calipso_cldtype(:,2)) |
---|
| 196 | endif |
---|
| 197 | if (cfg%Lclzopaquecalipso) then |
---|
| 198 | where(cospOUT%calipso_cldtype(:,3) == R_UNDEF) cospOUT%calipso_cldtype(:,3) = missing_val |
---|
| 199 | CALL histwrite2d_cosp(o_clzopaquecalipso,cospOUT%calipso_cldtype(:,3)) |
---|
| 200 | endif |
---|
| 201 | if (cfg%Lclcalipsoopaque) then |
---|
| 202 | where(cospOUT%calipso_lidarcldtype(:,:,1) == R_UNDEF) cospOUT%calipso_lidarcldtype(:,:,1) = missing_val |
---|
| 203 | CALL histwrite3d_cosp(o_clcalipsoopaque,cospOUT%calipso_lidarcldtype(:,:,1),nvert) |
---|
| 204 | endif |
---|
| 205 | if (cfg%Lclcalipsothin) then |
---|
| 206 | where(cospOUT%calipso_lidarcldtype(:,:,2) == R_UNDEF) cospOUT%calipso_lidarcldtype(:,:,2) = missing_val |
---|
| 207 | CALL histwrite3d_cosp(o_clcalipsothin,cospOUT%calipso_lidarcldtype(:,:,2),nvert) |
---|
| 208 | endif |
---|
| 209 | if (cfg%Lclcalipsozopaque) then |
---|
| 210 | where(cospOUT%calipso_lidarcldtype(:,:,3) == R_UNDEF) cospOUT%calipso_lidarcldtype(:,:,3) = missing_val |
---|
| 211 | CALL histwrite3d_cosp(o_clcalipsozopaque,cospOUT%calipso_lidarcldtype(:,:,3),nvert) |
---|
| 212 | endif |
---|
| 213 | if (cfg%Lclcalipsoopacity) then |
---|
| 214 | where(cospOUT%calipso_lidarcldtype(:,:,4) == R_UNDEF) cospOUT%calipso_lidarcldtype(:,:,4) = missing_val |
---|
| 215 | CALL histwrite3d_cosp(o_clcalipsoopacity,cospOUT%calipso_lidarcldtype(:,:,4),nvert) |
---|
| 216 | endif |
---|
[3491] | 217 | |
---|
[3723] | 218 | if (cfg%Lclopaquetemp) then |
---|
| 219 | where(cospOUT%calipso_cldtypetemp(:,1) == R_UNDEF) cospOUT%calipso_cldtypetemp(:,1) = missing_val |
---|
| 220 | CALL histwrite2d_cosp(o_clopaquetemp,cospOUT%calipso_cldtypetemp(:,1)) |
---|
| 221 | endif |
---|
| 222 | if (cfg%Lclthintemp) then |
---|
| 223 | where(cospOUT%calipso_cldtypetemp(:,2) == R_UNDEF) cospOUT%calipso_cldtypetemp(:,2) = missing_val |
---|
| 224 | CALL histwrite2d_cosp(o_clthintemp,cospOUT%calipso_cldtypetemp(:,2)) |
---|
| 225 | endif |
---|
| 226 | if (cfg%Lclzopaquetemp) then |
---|
| 227 | where(cospOUT%calipso_cldtypetemp(:,3) == R_UNDEF) cospOUT%calipso_cldtypetemp(:,3) = missing_val |
---|
| 228 | CALL histwrite2d_cosp(o_clzopaquetemp,cospOUT%calipso_cldtypetemp(:,3)) |
---|
| 229 | endif |
---|
| 230 | if (cfg%Lclopaquemeanz) then |
---|
| 231 | where(cospOUT%calipso_cldtypemeanz(:,1) == R_UNDEF) cospOUT%calipso_cldtypemeanz(:,1) = missing_val |
---|
| 232 | CALL histwrite2d_cosp(o_clopaquemeanz,cospOUT%calipso_cldtypemeanz(:,1)) |
---|
| 233 | endif |
---|
| 234 | if (cfg%Lclthinmeanz) then |
---|
| 235 | where(cospOUT%calipso_cldtypemeanz(:,2) == R_UNDEF) cospOUT%calipso_cldtypemeanz(:,2) = missing_val |
---|
| 236 | CALL histwrite2d_cosp(o_clthinmeanz,cospOUT%calipso_cldtypemeanz(:,2)) |
---|
| 237 | endif |
---|
| 238 | if (cfg%Lclthinemis) then |
---|
| 239 | where(cospOUT%calipso_cldthinemis == R_UNDEF) cospOUT%calipso_cldthinemis = missing_val |
---|
| 240 | CALL histwrite2d_cosp(o_clthinemis,cospOUT%calipso_cldthinemis) |
---|
| 241 | endif |
---|
| 242 | if (cfg%Lclopaquemeanzse) then |
---|
| 243 | where(cospOUT%calipso_cldtypemeanzse(:,1) == R_UNDEF) cospOUT%calipso_cldtypemeanzse(:,1) = missing_val |
---|
| 244 | CALL histwrite2d_cosp(o_clopaquemeanzse,cospOUT%calipso_cldtypemeanzse(:,1)) |
---|
| 245 | endif |
---|
| 246 | if (cfg%Lclthinmeanzse) then |
---|
| 247 | where(cospOUT%calipso_cldtypemeanzse(:,2) == R_UNDEF) cospOUT%calipso_cldtypemeanzse(:,2) = missing_val |
---|
| 248 | CALL histwrite2d_cosp(o_clthinmeanzse,cospOUT%calipso_cldtypemeanzse(:,2)) |
---|
| 249 | endif |
---|
| 250 | if (cfg%Lclzopaquecalipsose) then |
---|
| 251 | where(cospOUT%calipso_cldtypemeanzse(:,3) == R_UNDEF) cospOUT%calipso_cldtypemeanzse(:,3) = missing_val |
---|
| 252 | CALL histwrite2d_cosp(o_clzopaquecalipsose,cospOUT%calipso_cldtypemeanzse(:,3)) |
---|
| 253 | endif |
---|
[3491] | 254 | |
---|
| 255 | |
---|
[3723] | 256 | if (cfg%LcfadLidarsr532) then |
---|
| 257 | where(cospOUT%calipso_cfad_sr == R_UNDEF) cospOUT%calipso_cfad_sr = missing_val |
---|
| 258 | |
---|
[3491] | 259 | do icl=1,SR_BINS |
---|
[3723] | 260 | do k=1,Nlvgrid |
---|
| 261 | do ip=1,Npoints |
---|
| 262 | tmp_fi4da_cfadL(ip,k,icl)=cospOUT%calipso_cfad_sr(ip,icl,k) |
---|
| 263 | enddo |
---|
| 264 | enddo |
---|
[3491] | 265 | enddo |
---|
[3723] | 266 | ! if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr) |
---|
| 267 | CALL histwrite4d_cosp(o_cfadLidarsr532,tmp_fi4da_cfadL) !!! "_" enleve |
---|
[3491] | 268 | endif |
---|
| 269 | |
---|
| 270 | if (cfg%Latb532) then |
---|
[3723] | 271 | where(cospOUT%calipso_beta_tot == R_UNDEF) cospOUT%calipso_beta_tot = missing_val |
---|
| 272 | CALL histwrite4d_cosp(o_atb532,cospOUT%calipso_beta_tot) |
---|
| 273 | endif |
---|
| 274 | if (cfg%LlidarBetaMol532) then |
---|
[3731] | 275 | where(cospOUT%calipso_beta_mol == R_UNDEF) cospOUT%calipso_beta_mol = missing_val |
---|
[3723] | 276 | CALL histwrite3d_cosp(o_lidarBetaMol532,cospOUT%calipso_beta_mol,nvertmcosp) |
---|
| 277 | endif |
---|
[3491] | 278 | |
---|
| 279 | endif !Calipso |
---|
| 280 | |
---|
| 281 | |
---|
| 282 | !!!! Sorties Ground Lidar |
---|
| 283 | if (cfg%LgrLidar532) then |
---|
[3731] | 284 | ! AI juin 2020 Voir a quoi correspond ce champs |
---|
| 285 | ! where(cospOUT%grLidar532_srbval == R_UNDEF) cospOUT%grLidar532_srbval = missing_val |
---|
[3491] | 286 | |
---|
[3731] | 287 | if (cfg%LcllgrLidar532) then |
---|
| 288 | where(cospOUT%grLidar532_cldlayer(:,1) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,1) = missing_val |
---|
| 289 | CALL histwrite2d_cosp(o_cllgrLidar532,cospOUT%grLidar532_cldlayer(:,1)) |
---|
| 290 | endif |
---|
| 291 | if (cfg%LclmgrLidar532) then |
---|
| 292 | where(cospOUT%grLidar532_cldlayer(:,2) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,2) = missing_val |
---|
| 293 | CALL histwrite2d_cosp(o_clmgrLidar532,cospOUT%grLidar532_cldlayer(:,2)) |
---|
| 294 | endif |
---|
| 295 | if (cfg%LclhgrLidar532) then |
---|
| 296 | where(cospOUT%grLidar532_cldlayer(:,3) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,3) = missing_val |
---|
| 297 | CALL histwrite2d_cosp(o_clhgrLidar532,cospOUT%grLidar532_cldlayer(:,3)) |
---|
| 298 | endif |
---|
| 299 | if (cfg%LcltgrLidar532) then |
---|
| 300 | where(cospOUT%grLidar532_cldlayer(:,4) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,4) = missing_val |
---|
| 301 | CALL histwrite2d_cosp(o_cltgrLidar532,cospOUT%grLidar532_cldlayer(:,4)) |
---|
| 302 | endif |
---|
[3491] | 303 | |
---|
[3731] | 304 | if (cfg%LclgrLidar532) then |
---|
| 305 | where(cospOUT%grLidar532_lidarcld == R_UNDEF) cospOUT%grLidar532_lidarcld = missing_val |
---|
| 306 | CALL histwrite3d_cosp(o_clgrLidar532,cospOUT%grLidar532_lidarcld,nvert) |
---|
| 307 | endif |
---|
| 308 | if (cfg%LlidarBetaMol532gr) then |
---|
| 309 | where(cospOUT%grLidar532_beta_mol == R_UNDEF) cospOUT%grLidar532_beta_mol = missing_val |
---|
| 310 | CALL histwrite3d_cosp(o_lidarBetaMol532gr,cospOUT%grLidar532_beta_mol,nvertmcosp) |
---|
| 311 | endif |
---|
| 312 | if (cfg%LcfadLidarsr532gr) then |
---|
| 313 | where(cospOUT%grLidar532_cfad_sr == R_UNDEF) cospOUT%grLidar532_cfad_sr = missing_val |
---|
| 314 | do icl=1,SR_BINS |
---|
[3723] | 315 | do k=1,Nlvgrid |
---|
| 316 | do ip=1,Npoints |
---|
| 317 | tmp_fi4da_cfadLgr(ip,k,icl)=cospOUT%grLidar532_cfad_sr(ip,icl,k) |
---|
| 318 | enddo |
---|
| 319 | enddo |
---|
[3731] | 320 | enddo |
---|
| 321 | CALL histwrite4d_cosp(o_cfadLidarsr532gr,tmp_fi4da_cfadLgr) |
---|
| 322 | endif |
---|
[3491] | 323 | |
---|
[3731] | 324 | if (cfg%Latb532gr) then |
---|
| 325 | where(cospOUT%grLidar532_beta_tot == R_UNDEF) cospOUT%grLidar532_beta_tot = missing_val |
---|
| 326 | CALL histwrite4d_cosp(o_atb532gr,cospOUT%grLidar532_beta_tot) |
---|
| 327 | endif |
---|
[3491] | 328 | endif ! Ground Lidar 532 nm |
---|
| 329 | |
---|
| 330 | |
---|
| 331 | !!!! Sorties Atlid |
---|
| 332 | if (cfg%Latlid) then |
---|
[3731] | 333 | ! AI juin 2020 Voir a quoi correspond ce champs |
---|
| 334 | ! where(cospOUT%atlid_srbval == R_UNDEF) cospOUT%atlid_srbval = missing_val |
---|
[3491] | 335 | |
---|
[3731] | 336 | if (cfg%Lcllatlid) then |
---|
| 337 | where(cospOUT%atlid_cldlayer(:,1) == R_UNDEF) cospOUT%atlid_cldlayer(:,1) = missing_val |
---|
| 338 | CALL histwrite2d_cosp(o_cllatlid,cospOUT%atlid_cldlayer(:,1)) |
---|
| 339 | endif |
---|
| 340 | if (cfg%Lclmatlid) then |
---|
| 341 | where(cospOUT%atlid_cldlayer(:,2) == R_UNDEF) cospOUT%atlid_cldlayer(:,2) = missing_val |
---|
| 342 | CALL histwrite2d_cosp(o_clmatlid,cospOUT%atlid_cldlayer(:,2)) |
---|
| 343 | endif |
---|
| 344 | if (cfg%Lclhatlid) then |
---|
| 345 | where(cospOUT%atlid_cldlayer(:,3) == R_UNDEF) cospOUT%atlid_cldlayer(:,3) = missing_val |
---|
| 346 | CALL histwrite2d_cosp(o_clhatlid,cospOUT%atlid_cldlayer(:,3)) |
---|
| 347 | endif |
---|
| 348 | if (cfg%Lcltatlid) then |
---|
| 349 | where(cospOUT%atlid_cldlayer(:,4) == R_UNDEF) cospOUT%atlid_cldlayer(:,4) = missing_val |
---|
| 350 | CALL histwrite2d_cosp(o_cltatlid,cospOUT%atlid_cldlayer(:,4)) |
---|
| 351 | endif |
---|
| 352 | if (cfg%Lclatlid) then |
---|
| 353 | where(cospOUT%atlid_lidarcld == R_UNDEF) cospOUT%atlid_lidarcld = missing_val |
---|
| 354 | CALL histwrite3d_cosp(o_clatlid,cospOUT%atlid_lidarcld,nvert) |
---|
| 355 | endif |
---|
| 356 | if (cfg%LlidarBetaMol355) then |
---|
| 357 | where(cospOUT%atlid_beta_mol == R_UNDEF) cospOUT%atlid_beta_mol = missing_val |
---|
| 358 | CALL histwrite3d_cosp(o_lidarBetaMol355,cospOUT%atlid_beta_mol,nvertmcosp) |
---|
| 359 | endif |
---|
| 360 | if (cfg%LcfadLidarsr355) then |
---|
| 361 | where(cospOUT%atlid_cfad_sr == R_UNDEF) cospOUT%atlid_cfad_sr = missing_val |
---|
| 362 | do icl=1,SR_BINS |
---|
[3723] | 363 | do k=1,Nlvgrid |
---|
| 364 | do ip=1,Npoints |
---|
| 365 | tmp_fi4da_cfadLatlid(ip,k,icl)=cospOUT%atlid_cfad_sr(ip,icl,k) |
---|
| 366 | enddo |
---|
| 367 | enddo |
---|
[3731] | 368 | enddo |
---|
| 369 | CALL histwrite4d_cosp(o_cfadlidarsr355,tmp_fi4da_cfadLatlid) |
---|
| 370 | endif |
---|
[3491] | 371 | |
---|
[3731] | 372 | if (cfg%Latb355) then |
---|
| 373 | where(cospOUT%atlid_beta_tot == R_UNDEF) cospOUT%atlid_beta_tot = missing_val |
---|
| 374 | CALL histwrite4d_cosp(o_atb355,cospOUT%atlid_beta_tot) |
---|
| 375 | endif |
---|
[3491] | 376 | endif ! Atlid |
---|
| 377 | |
---|
| 378 | |
---|
| 379 | if (cfg%Lparasol) then |
---|
| 380 | if (cfg%LparasolRefl) then |
---|
[3731] | 381 | where(cospOUT%parasolGrid_refl == R_UNDEF) cospOUT%parasolGrid_refl = missing_val |
---|
| 382 | where(cospOUT%parasolPix_refl == R_UNDEF) cospOUT%parasolPix_refl = missing_val |
---|
[3491] | 383 | CALL histwrite3d_cosp(o_parasolGrid_refl,cospOUT%parasolGrid_refl,nvertp) |
---|
| 384 | CALL histwrite4d_cosp(o_parasolPix_refl,cospOUT%parasolPix_refl) |
---|
[3731] | 385 | endif ! LparasolRefl |
---|
| 386 | endif ! Parasol |
---|
[3491] | 387 | |
---|
| 388 | ! if (cfg%LparasolRefl) then |
---|
| 389 | ! do k=1,PARASOL_NREFL |
---|
| 390 | ! do ip=1, Npoints |
---|
| 391 | ! if (stlidar%cldlayer(ip,4).gt.1.and.stlidar%parasolrefl(ip,k).ne.missing_val) then |
---|
| 392 | ! parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)/100.))/ & |
---|
| 393 | ! (stlidar%cldlayer(ip,4)/100.) |
---|
| 394 | ! Ncref(ip,k) = 1. |
---|
| 395 | ! else |
---|
| 396 | ! parasolcrefl(ip,k)=missing_val |
---|
| 397 | ! Ncref(ip,k) = 0. |
---|
| 398 | ! endif |
---|
| 399 | ! enddo |
---|
| 400 | ! enddo |
---|
| 401 | ! CALL histwrite3d_cosp(o_Ncrefl,Ncref,nvertp) |
---|
| 402 | ! CALL histwrite3d_cosp(o_parasol_crefl,parasolcrefl,nvertp) |
---|
| 403 | ! endif |
---|
| 404 | |
---|
| 405 | |
---|
| 406 | !!! Sorties CloudSat |
---|
| 407 | if (cfg%Lcloudsat) then |
---|
[3731] | 408 | ! AI juin 2020 voir a quoi correspond ce champs |
---|
| 409 | ! where(cospOUT%cloudsat_pia == R_UNDEF) cospOUT%cloudsat_pia = missing_val |
---|
[3491] | 410 | |
---|
[3731] | 411 | if (cfg%Lptradarflag0) then |
---|
| 412 | where(cospOUT%cloudsat_precip_cover(:,1) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,1) = missing_val |
---|
| 413 | CALL histwrite2d_cosp(o_ptradarflag0,cospOUT%cloudsat_precip_cover(:,1)) |
---|
| 414 | endif |
---|
| 415 | if (cfg%Lptradarflag1) then |
---|
| 416 | where(cospOUT%cloudsat_precip_cover(:,2) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,2) = missing_val |
---|
| 417 | CALL histwrite2d_cosp(o_ptradarflag1,cospOUT%cloudsat_precip_cover(:,2)) |
---|
| 418 | endif |
---|
| 419 | if (cfg%Lptradarflag2) then |
---|
| 420 | where(cospOUT%cloudsat_precip_cover(:,3) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,3) = missing_val |
---|
| 421 | CALL histwrite2d_cosp(o_ptradarflag2,cospOUT%cloudsat_precip_cover(:,3)) |
---|
| 422 | endif |
---|
| 423 | if (cfg%Lptradarflag3) then |
---|
| 424 | where(cospOUT%cloudsat_precip_cover(:,4) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,4) = missing_val |
---|
| 425 | CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,4)) |
---|
| 426 | endif |
---|
| 427 | if (cfg%Lptradarflag4) then |
---|
| 428 | where(cospOUT%cloudsat_precip_cover(:,5) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,5) = missing_val |
---|
| 429 | CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,5)) |
---|
| 430 | endif |
---|
| 431 | if (cfg%Lptradarflag5) then |
---|
| 432 | where(cospOUT%cloudsat_precip_cover(:,6) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,6) = missing_val |
---|
| 433 | CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,6)) |
---|
| 434 | endif |
---|
| 435 | if (cfg%Lptradarflag6) then |
---|
| 436 | where(cospOUT%cloudsat_precip_cover(:,7) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,7) = missing_val |
---|
| 437 | CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,7)) |
---|
| 438 | endif |
---|
| 439 | if (cfg%Lptradarflag7) then |
---|
| 440 | where(cospOUT%cloudsat_precip_cover(:,8) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,8) = missing_val |
---|
| 441 | CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,8)) |
---|
| 442 | endif |
---|
| 443 | if (cfg%Lptradarflag8) then |
---|
| 444 | where(cospOUT%cloudsat_precip_cover(:,9) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,9) = missing_val |
---|
| 445 | CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,9)) |
---|
| 446 | endif |
---|
| 447 | if (cfg%Lptradarflag9) then |
---|
| 448 | where(cospOUT%cloudsat_precip_cover(:,10) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,10) = missing_val |
---|
| 449 | CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,10)) |
---|
| 450 | endif |
---|
[3491] | 451 | |
---|
[3731] | 452 | if (cfg%Ldbze94) then |
---|
| 453 | where(cospOUT%cloudsat_Ze_tot == R_UNDEF) cospOUT%cloudsat_Ze_tot = missing_val |
---|
| 454 | CALL histwrite4d_cosp(o_dbze94,cospOUT%cloudsat_Ze_tot) |
---|
| 455 | endif |
---|
| 456 | if (cfg%LcfadDbze94) then |
---|
| 457 | where(cospOUT%cloudsat_cfad_ze == R_UNDEF) cospOUT%cloudsat_cfad_ze = missing_val |
---|
| 458 | do icl=1,CLOUDSAT_DBZE_BINS |
---|
[3723] | 459 | do k=1,Nlvgrid |
---|
| 460 | do ip=1,Npoints |
---|
| 461 | tmp_fi4da_cfadR(ip,k,icl)=cospOUT%cloudsat_cfad_ze(ip,icl,k) |
---|
| 462 | enddo |
---|
| 463 | enddo |
---|
[3731] | 464 | enddo |
---|
| 465 | CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR) |
---|
| 466 | endif |
---|
[3491] | 467 | endif |
---|
| 468 | ! endif pour CloudSat |
---|
| 469 | |
---|
| 470 | |
---|
| 471 | !!! Sorties combinees Cloudsat et Calipso |
---|
| 472 | if (cfg%Lcalipso .and. cfg%Lcloudsat) then |
---|
[3731] | 473 | |
---|
| 474 | if (cfg%Lclcalipso2) then |
---|
| 475 | where(cospOUT%lidar_only_freq_cloud == R_UNDEF) & |
---|
[3491] | 476 | cospOUT%lidar_only_freq_cloud = missing_val |
---|
[3731] | 477 | CALL histwrite3d_cosp(o_clcalipso2,cospOUT%lidar_only_freq_cloud,nvert) |
---|
| 478 | endif |
---|
| 479 | if (cfg%Lcloudsat_tcc) then |
---|
| 480 | where(cospOUT%cloudsat_tcc == R_UNDEF) & |
---|
[3491] | 481 | cospOUT%cloudsat_tcc = missing_val |
---|
[3731] | 482 | CALL histwrite2d_cosp(o_cloudsat_tcc,cospOUT%cloudsat_tcc) |
---|
| 483 | endif |
---|
| 484 | if (cfg%Lcloudsat_tcc2) then |
---|
| 485 | where(cospOUT%cloudsat_tcc2 == R_UNDEF) & |
---|
[3491] | 486 | cospOUT%cloudsat_tcc2 = missing_val |
---|
[3731] | 487 | CALL histwrite2d_cosp(o_cloudsat_tcc2,cospOUT%cloudsat_tcc2) |
---|
| 488 | endif |
---|
| 489 | if (cfg%Lcltlidarradar) then |
---|
| 490 | where(cospOUT%radar_lidar_tcc == R_UNDEF) & |
---|
| 491 | cospOUT%radar_lidar_tcc = missing_val |
---|
| 492 | CALL histwrite2d_cosp(o_cltlidarradar,cospOUT%radar_lidar_tcc) |
---|
| 493 | endif |
---|
[3491] | 494 | endif |
---|
| 495 | |
---|
| 496 | |
---|
| 497 | !!! Sorties Isccp |
---|
| 498 | if (cfg%Lisccp) then |
---|
| 499 | where(cospOUT%isccp_totalcldarea == R_UNDEF) cospOUT%isccp_totalcldarea = missing_val |
---|
| 500 | where(cospOUT%isccp_meanptop == R_UNDEF) cospOUT%isccp_meanptop = missing_val |
---|
| 501 | where(cospOUT%isccp_meantaucld == R_UNDEF) cospOUT%isccp_meantaucld = missing_val |
---|
| 502 | where(cospOUT%isccp_meanalbedocld == R_UNDEF) cospOUT%isccp_meanalbedocld = missing_val |
---|
| 503 | where(cospOUT%isccp_meantb == R_UNDEF) cospOUT%isccp_meantb = missing_val |
---|
| 504 | where(cospOUT%isccp_meantbclr == R_UNDEF) cospOUT%isccp_meantbclr = missing_val |
---|
| 505 | where(cospOUT%isccp_fq == R_UNDEF) cospOUT%isccp_fq = missing_val |
---|
| 506 | where(cospOUT%isccp_boxtau == R_UNDEF) cospOUT%isccp_boxtau = missing_val |
---|
| 507 | where(cospOUT%isccp_boxptop == R_UNDEF) cospOUT%isccp_boxptop = missing_val |
---|
| 508 | |
---|
| 509 | ! CALL histwrite2d_cosp(o_sunlit,gbx%sunlit) |
---|
| 510 | if (cfg%Lclisccp) CALL histwrite4d_cosp(o_clisccp,cospOUT%isccp_fq) |
---|
| 511 | |
---|
| 512 | if (cfg%Lboxtauisccp) CALL histwrite3d_cosp(o_boxtauisccp,cospOUT%isccp_boxtau,nvertcol) |
---|
| 513 | if (cfg%Lboxptopisccp) CALL histwrite3d_cosp(o_boxptopisccp,cospOUT%isccp_boxptop,nvertcol) |
---|
| 514 | if (cfg%Lcltisccp) CALL histwrite2d_cosp(o_cltisccp,cospOUT%isccp_totalcldarea) |
---|
| 515 | if (cfg%Lpctisccp) CALL histwrite2d_cosp(o_pctisccp,cospOUT%isccp_meanptop) |
---|
| 516 | if (cfg%Ltauisccp) CALL histwrite2d_cosp(o_tauisccp,cospOUT%isccp_meantaucld) |
---|
| 517 | if (cfg%Lalbisccp) CALL histwrite2d_cosp(o_albisccp,cospOUT%isccp_meanalbedocld) |
---|
| 518 | if (cfg%Lmeantbisccp) CALL histwrite2d_cosp(o_meantbisccp,cospOUT%isccp_meantb) |
---|
| 519 | if (cfg%Lmeantbclrisccp) CALL histwrite2d_cosp(o_meantbclrisccp,cospOUT%isccp_meantbclr) |
---|
| 520 | endif ! Isccp |
---|
| 521 | |
---|
| 522 | |
---|
| 523 | !!! MISR simulator |
---|
| 524 | if (cfg%Lmisr) then |
---|
| 525 | |
---|
| 526 | if (cfg%LclMISR) then |
---|
| 527 | ! Ces 3 diagnostics sont controles par la clef logique "LclMISR" |
---|
| 528 | where(cospOUT%misr_fq == R_UNDEF) cospOUT%misr_fq = missing_val |
---|
| 529 | ! where(cospOUT%misr_dist_model_layertops == R_UNDEF) cospOUT%misr_dist_model_layertops = missing_val |
---|
| 530 | where(cospOUT%misr_meanztop == R_UNDEF) cospOUT%misr_meanztop = missing_val |
---|
| 531 | where(cospOUT%misr_cldarea == R_UNDEF) cospOUT%misr_cldarea = missing_val |
---|
| 532 | |
---|
| 533 | do icl=1,numMISRHgtBins |
---|
[3723] | 534 | do k=1,Nlvgrid |
---|
| 535 | do ip=1,Npoints |
---|
| 536 | tmp_fi4da_misr(ip,icl,k)=cospOUT%misr_fq(ip,k,icl) |
---|
| 537 | enddo |
---|
| 538 | enddo |
---|
[3491] | 539 | enddo |
---|
| 540 | ! if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,misr%fq_MISR) |
---|
| 541 | ! if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,tmp_fi4da_misr) |
---|
| 542 | CALL histwrite4d_cosp(o_misr_fq,tmp_fi4da_misr) |
---|
| 543 | |
---|
| 544 | CALL histwrite2d_cosp(o_misr_meanztop,cospOUT%misr_meanztop) |
---|
| 545 | CALL histwrite2d_cosp(o_misr_cldarea,cospOUT%misr_cldarea) |
---|
| 546 | endif ! LclMISR |
---|
| 547 | |
---|
| 548 | endif ! Misr |
---|
| 549 | |
---|
| 550 | |
---|
| 551 | !!! Modis simulator |
---|
| 552 | if (cfg%Lmodis) then |
---|
| 553 | where(cospOUT%modis_Cloud_Fraction_Low_Mean == R_UNDEF) & |
---|
| 554 | cospOUT%modis_Cloud_Fraction_Low_Mean = missing_val |
---|
| 555 | where(cospOUT%modis_Cloud_Fraction_High_Mean == R_UNDEF) & |
---|
| 556 | cospOUT%modis_Cloud_Fraction_High_Mean = missing_val |
---|
| 557 | where(cospOUT%modis_Cloud_Fraction_Mid_Mean == R_UNDEF) & |
---|
| 558 | cospOUT%modis_Cloud_Fraction_Mid_Mean = missing_val |
---|
| 559 | where(cospOUT%modis_Cloud_Fraction_Total_Mean == R_UNDEF) & |
---|
| 560 | cospOUT%modis_Cloud_Fraction_Total_Mean = missing_val |
---|
| 561 | where(cospOUT%modis_Cloud_Fraction_Water_Mean == R_UNDEF) & |
---|
| 562 | cospOUT%modis_Cloud_Fraction_Water_Mean = missing_val |
---|
| 563 | where(cospOUT%modis_Cloud_Fraction_Ice_Mean == R_UNDEF) & |
---|
| 564 | cospOUT%modis_Cloud_Fraction_Ice_Mean = missing_val |
---|
| 565 | where(cospOUT%modis_Optical_Thickness_Total_Mean == R_UNDEF) & |
---|
| 566 | cospOUT%modis_Optical_Thickness_Total_Mean = missing_val |
---|
| 567 | where(cospOUT%modis_Optical_Thickness_Water_Mean == R_UNDEF) & |
---|
| 568 | cospOUT%modis_Optical_Thickness_Water_Mean = missing_val |
---|
| 569 | where(cospOUT%modis_Optical_Thickness_Ice_Mean == R_UNDEF) & |
---|
| 570 | cospOUT%modis_Optical_Thickness_Ice_Mean = missing_val |
---|
| 571 | where(cospOUT%modis_Cloud_Particle_Size_Water_Mean == R_UNDEF) & |
---|
| 572 | cospOUT%modis_Cloud_Particle_Size_Water_Mean = missing_val |
---|
| 573 | where(cospOUT%modis_Cloud_Particle_Size_Ice_Mean == R_UNDEF) & |
---|
| 574 | cospOUT%modis_Cloud_Particle_Size_Ice_Mean = missing_val |
---|
| 575 | where(cospOUT%modis_Cloud_Top_Pressure_Total_Mean == R_UNDEF) & |
---|
| 576 | cospOUT%modis_Cloud_Top_Pressure_Total_Mean = missing_val |
---|
| 577 | where(cospOUT%modis_Liquid_Water_Path_Mean == R_UNDEF) & |
---|
| 578 | cospOUT%modis_Liquid_Water_Path_Mean = missing_val |
---|
| 579 | where(cospOUT%modis_Ice_Water_Path_Mean == R_UNDEF) & |
---|
| 580 | cospOUT%modis_Ice_Water_Path_Mean = missing_val |
---|
| 581 | where(cospOUT%modis_Optical_Thickness_Total_LogMean == R_UNDEF) & |
---|
| 582 | cospOUT%modis_Optical_Thickness_Total_LogMean = missing_val |
---|
| 583 | where(cospOUT%modis_Optical_Thickness_Water_LogMean == R_UNDEF) & |
---|
| 584 | cospOUT%modis_Optical_Thickness_Water_LogMean = missing_val |
---|
| 585 | where(cospOUT%modis_Optical_Thickness_Ice_LogMean == R_UNDEF) & |
---|
| 586 | cospOUT%modis_Optical_Thickness_Ice_LogMean = missing_val |
---|
| 587 | |
---|
| 588 | if (cfg%Lcllmodis) CALL histwrite2d_cosp(o_cllmodis,cospOUT%modis_Cloud_Fraction_Low_Mean) |
---|
| 589 | if (cfg%Lclhmodis) CALL histwrite2d_cosp(o_clhmodis,cospOUT%modis_Cloud_Fraction_High_Mean) |
---|
| 590 | if (cfg%Lclmmodis) CALL histwrite2d_cosp(o_clmmodis,cospOUT%modis_Cloud_Fraction_Mid_Mean) |
---|
| 591 | if (cfg%Lcltmodis) CALL histwrite2d_cosp(o_cltmodis,cospOUT%modis_Cloud_Fraction_Total_Mean) |
---|
| 592 | if (cfg%Lclwmodis) CALL histwrite2d_cosp(o_clwmodis,cospOUT%modis_Cloud_Fraction_Water_Mean) |
---|
| 593 | if (cfg%Lclimodis) CALL histwrite2d_cosp(o_climodis,cospOUT%modis_Cloud_Fraction_Ice_Mean) |
---|
| 594 | if (cfg%Ltautmodis) CALL histwrite2d_cosp(o_tautmodis,cospOUT%modis_Optical_Thickness_Total_Mean) |
---|
| 595 | if (cfg%Ltauwmodis) CALL histwrite2d_cosp(o_tauwmodis,cospOUT%modis_Optical_Thickness_Water_Mean) |
---|
| 596 | if (cfg%Ltauimodis) CALL histwrite2d_cosp(o_tauimodis,cospOUT%modis_Optical_Thickness_Ice_Mean) |
---|
| 597 | if (cfg%Ltautlogmodis) CALL histwrite2d_cosp(o_tautlogmodis,cospOUT%modis_Optical_Thickness_Total_LogMean) |
---|
| 598 | if (cfg%Ltauwlogmodis) CALL histwrite2d_cosp(o_tauwlogmodis,cospOUT%modis_Optical_Thickness_Water_LogMean) |
---|
| 599 | if (cfg%Ltauilogmodis) CALL histwrite2d_cosp(o_tauilogmodis,cospOUT%modis_Optical_Thickness_Ice_LogMean) |
---|
| 600 | if (cfg%Lreffclwmodis) CALL histwrite2d_cosp(o_reffclwmodis,cospOUT%modis_Cloud_Particle_Size_Water_Mean) |
---|
| 601 | if (cfg%Lreffclimodis) CALL histwrite2d_cosp(o_reffclimodis,cospOUT%modis_Cloud_Particle_Size_Ice_Mean) |
---|
| 602 | if (cfg%Lpctmodis) CALL histwrite2d_cosp(o_pctmodis,cospOUT%modis_Cloud_Top_Pressure_Total_Mean) |
---|
| 603 | if (cfg%Llwpmodis) CALL histwrite2d_cosp(o_lwpmodis,cospOUT%modis_Liquid_Water_Path_Mean) |
---|
| 604 | if (cfg%Liwpmodis) CALL histwrite2d_cosp(o_iwpmodis,cospOUT%modis_Ice_Water_Path_Mean) |
---|
| 605 | |
---|
| 606 | if (cfg%Lclmodis) then |
---|
| 607 | ! Ces 3 diagnostics sont controles par la clef logique "Lclmodis" |
---|
| 608 | where(cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure == R_UNDEF) & |
---|
| 609 | cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure = missing_val |
---|
| 610 | where(cospOUT%modis_Optical_Thickness_vs_ReffICE == R_UNDEF) & |
---|
| 611 | cospOUT%modis_Optical_Thickness_vs_ReffICE = missing_val |
---|
| 612 | where(cospOUT%modis_Optical_thickness_vs_ReffLIQ == R_UNDEF) & |
---|
| 613 | cospOUT%modis_Optical_thickness_vs_ReffLIQ = missing_val |
---|
| 614 | |
---|
| 615 | CALL histwrite4d_cosp(o_modis_ot_vs_ctp,cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure) |
---|
| 616 | CALL histwrite4d_cosp(o_modis_ot_vs_reffice,cospOUT%modis_Optical_Thickness_vs_ReffICE) |
---|
| 617 | CALL histwrite4d_cosp(o_modis_ot_vs_reffliq,cospOUT%modis_Optical_thickness_vs_ReffLIQ) |
---|
| 618 | |
---|
| 619 | endif ! Lclmodis |
---|
| 620 | |
---|
| 621 | endif !modis |
---|
| 622 | |
---|
| 623 | |
---|
| 624 | IF(.NOT.cosp_varsdefined) THEN |
---|
| 625 | !$OMP MASTER |
---|
| 626 | ! Fermeture dans phys_output_write |
---|
[3723] | 627 | !#ifdef 1 |
---|
[3491] | 628 | !On finalise l'initialisation: |
---|
| 629 | !CALL wxios_closedef() |
---|
| 630 | !#endif |
---|
| 631 | |
---|
| 632 | !$OMP END MASTER |
---|
| 633 | !$OMP BARRIER |
---|
| 634 | cosp_varsdefined = .TRUE. |
---|
| 635 | END IF |
---|
| 636 | |
---|
| 637 | IF(cosp_varsdefined) THEN |
---|
| 638 | ! On synchronise les fichiers pour IOIPSL |
---|
| 639 | ENDIF !cosp_varsdefined |
---|
| 640 | |
---|
| 641 | END SUBROUTINE lmdz_cosp_output_write |
---|
| 642 | |
---|
| 643 | |
---|
| 644 | ! ug Routine pour definir itau_iocosp depuis cosp_output_write_mod: |
---|
| 645 | SUBROUTINE set_itau_iocosp(ito) |
---|
| 646 | IMPLICIT NONE |
---|
| 647 | INTEGER, INTENT(IN) :: ito |
---|
| 648 | itau_iocosp = ito |
---|
| 649 | END SUBROUTINE |
---|
| 650 | |
---|
| 651 | SUBROUTINE histdef2d_cosp (iff,var) |
---|
| 652 | |
---|
| 653 | USE ioipsl |
---|
| 654 | USE dimphy |
---|
| 655 | use iophy |
---|
| 656 | USE mod_phys_lmdz_para |
---|
| 657 | USE mod_grid_phy_lmdz, ONLY: nbp_lon |
---|
| 658 | USE print_control_mod, ONLY: lunout,prt_level |
---|
| 659 | USE wxios |
---|
| 660 | |
---|
| 661 | IMPLICIT NONE |
---|
| 662 | |
---|
| 663 | INCLUDE "clesphys.h" |
---|
| 664 | |
---|
| 665 | INTEGER :: iff |
---|
| 666 | TYPE(ctrl_outcosp) :: var |
---|
| 667 | |
---|
| 668 | REAL zstophym |
---|
| 669 | CHARACTER(LEN=20) :: typeecrit |
---|
| 670 | |
---|
| 671 | ! ug On récupère le type écrit de la structure: |
---|
| 672 | ! Assez moche, Ã| refaire si meilleure méthode... |
---|
| 673 | IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN |
---|
| 674 | typeecrit = 'once' |
---|
| 675 | ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN |
---|
| 676 | typeecrit = 't_min(X)' |
---|
| 677 | ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN |
---|
| 678 | typeecrit = 't_max(X)' |
---|
| 679 | ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN |
---|
| 680 | typeecrit = 'inst(X)' |
---|
| 681 | ELSE |
---|
| 682 | typeecrit = cosp_outfiletypes(iff) |
---|
| 683 | ENDIF |
---|
| 684 | |
---|
| 685 | IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN |
---|
| 686 | zstophym=zoutm_cosp(iff) |
---|
| 687 | ELSE |
---|
| 688 | zstophym=zdtimemoy_cosp |
---|
| 689 | ENDIF |
---|
| 690 | |
---|
| 691 | IF (.not. ok_all_xml) then |
---|
| 692 | IF ( var%cles(iff) ) THEN |
---|
| 693 | if (prt_level >= 10) then |
---|
| 694 | WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name |
---|
| 695 | endif |
---|
| 696 | CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), & |
---|
| 697 | var%description, var%unit, 1, typeecrit) |
---|
| 698 | ENDIF |
---|
| 699 | ENDIF |
---|
| 700 | |
---|
| 701 | |
---|
| 702 | END SUBROUTINE histdef2d_cosp |
---|
| 703 | |
---|
| 704 | |
---|
| 705 | SUBROUTINE histdef3d_cosp (iff,var,nvertsave,ncols) |
---|
| 706 | USE ioipsl |
---|
| 707 | USE dimphy |
---|
| 708 | use iophy |
---|
| 709 | USE mod_phys_lmdz_para |
---|
| 710 | USE mod_grid_phy_lmdz, ONLY: nbp_lon |
---|
| 711 | USE print_control_mod, ONLY: lunout,prt_level |
---|
| 712 | |
---|
| 713 | USE wxios |
---|
| 714 | |
---|
| 715 | |
---|
| 716 | IMPLICIT NONE |
---|
| 717 | |
---|
| 718 | INCLUDE "clesphys.h" |
---|
| 719 | |
---|
| 720 | INTEGER :: iff, klevs |
---|
| 721 | INTEGER, INTENT(IN), OPTIONAL :: ncols ! ug RUSTINE POUR LES variables 4D |
---|
| 722 | INTEGER, INTENT(IN) :: nvertsave |
---|
| 723 | TYPE(ctrl_outcosp) :: var |
---|
| 724 | |
---|
| 725 | REAL zstophym |
---|
| 726 | CHARACTER(LEN=20) :: typeecrit, nomi |
---|
| 727 | CHARACTER(LEN=20) :: nom |
---|
| 728 | character(len=2) :: str2 |
---|
| 729 | CHARACTER(len=20) :: nam_axvert |
---|
| 730 | |
---|
| 731 | ! Axe vertical |
---|
| 732 | IF (nvertsave.eq.nvertp(iff)) THEN |
---|
| 733 | klevs=PARASOL_NREFL |
---|
| 734 | nam_axvert="sza" |
---|
| 735 | ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN |
---|
| 736 | klevs=7 |
---|
| 737 | nam_axvert="pressure2" |
---|
| 738 | ELSE IF (nvertsave.eq.nvertcol(iff)) THEN |
---|
| 739 | klevs=Ncolout |
---|
| 740 | nam_axvert="column" |
---|
| 741 | ELSE IF (nvertsave.eq.nverttemp(iff)) THEN |
---|
| 742 | klevs=LIDAR_NTEMP |
---|
| 743 | nam_axvert="temp" |
---|
| 744 | ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN |
---|
| 745 | klevs=numMISRHgtBins |
---|
| 746 | nam_axvert="cth16" |
---|
| 747 | ELSE IF (nvertsave.eq.nvertReffIce(iff)) THEN |
---|
| 748 | klevs= numMODISReffIceBins |
---|
| 749 | nam_axvert="ReffIce" |
---|
| 750 | ELSE IF (nvertsave.eq.nvertReffLiq(iff)) THEN |
---|
| 751 | klevs= numMODISReffLiqBins |
---|
| 752 | nam_axvert="ReffLiq" |
---|
| 753 | ELSE |
---|
| 754 | klevs=Nlevout |
---|
| 755 | nam_axvert="presnivs" |
---|
| 756 | ENDIF |
---|
| 757 | |
---|
| 758 | ! ug RUSTINE POUR LES Champs 4D |
---|
| 759 | IF (PRESENT(ncols)) THEN |
---|
| 760 | write(str2,'(i2.2)')ncols |
---|
| 761 | nomi=var%name |
---|
| 762 | nom="c"//str2//"_"//nomi |
---|
| 763 | ELSE |
---|
| 764 | nom=var%name |
---|
| 765 | END IF |
---|
| 766 | |
---|
| 767 | ! ug On récupère le type écrit de la structure: |
---|
| 768 | ! Assez moche, Ã| refaire si meilleure méthode... |
---|
| 769 | IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN |
---|
| 770 | typeecrit = 'once' |
---|
| 771 | ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN |
---|
| 772 | typeecrit = 't_min(X)' |
---|
| 773 | ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN |
---|
| 774 | typeecrit = 't_max(X)' |
---|
| 775 | ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN |
---|
| 776 | typeecrit = 'inst(X)' |
---|
| 777 | ELSE |
---|
| 778 | typeecrit = cosp_outfiletypes(iff) |
---|
| 779 | ENDIF |
---|
| 780 | |
---|
| 781 | IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN |
---|
| 782 | zstophym=zoutm_cosp(iff) |
---|
| 783 | ELSE |
---|
| 784 | zstophym=zdtimemoy_cosp |
---|
| 785 | ENDIF |
---|
| 786 | |
---|
| 787 | IF (.not. ok_all_xml) then |
---|
| 788 | IF ( var%cles(iff) ) THEN |
---|
| 789 | if (prt_level >= 10) then |
---|
| 790 | WRITE(lunout,*)'Appel wxios_add_field_to_file 3d nom variable nam_axvert = ',nom, nam_axvert |
---|
| 791 | endif |
---|
| 792 | CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), & |
---|
| 793 | var%description, var%unit, 1, typeecrit, nam_axvert) |
---|
| 794 | ENDIF |
---|
| 795 | ENDIF |
---|
| 796 | |
---|
| 797 | |
---|
| 798 | END SUBROUTINE histdef3d_cosp |
---|
| 799 | |
---|
| 800 | |
---|
| 801 | SUBROUTINE histwrite2d_cosp(var,field) |
---|
| 802 | USE dimphy |
---|
| 803 | USE mod_phys_lmdz_para |
---|
| 804 | USE ioipsl |
---|
| 805 | use iophy |
---|
| 806 | USE mod_grid_phy_lmdz, ONLY: nbp_lon |
---|
| 807 | USE print_control_mod, ONLY: lunout,prt_level |
---|
| 808 | |
---|
[4727] | 809 | USE lmdz_xios, only: xios_send_field |
---|
[3491] | 810 | |
---|
| 811 | IMPLICIT NONE |
---|
| 812 | INCLUDE 'clesphys.h' |
---|
| 813 | |
---|
| 814 | TYPE(ctrl_outcosp), INTENT(IN) :: var |
---|
| 815 | REAL, DIMENSION(:), INTENT(IN) :: field |
---|
| 816 | |
---|
| 817 | INTEGER :: iff |
---|
| 818 | |
---|
| 819 | REAL,DIMENSION(klon_mpi) :: buffer_omp |
---|
| 820 | INTEGER, allocatable, DIMENSION(:) :: index2d |
---|
| 821 | REAL :: Field2d(nbp_lon,jj_nb) |
---|
| 822 | CHARACTER(LEN=20) :: nomi, nom |
---|
| 823 | character(len=2) :: str2 |
---|
| 824 | LOGICAL, SAVE :: firstx |
---|
| 825 | !$OMP THREADPRIVATE(firstx) |
---|
| 826 | |
---|
| 827 | IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name |
---|
| 828 | |
---|
| 829 | ! On regarde si on est dans la phase de définition ou d'écriture: |
---|
| 830 | IF(.NOT.cosp_varsdefined) THEN |
---|
| 831 | !$OMP MASTER |
---|
[3723] | 832 | print*,'var, cosp_varsdefined dans cosp_varsdefined ',var%name, cosp_varsdefined |
---|
[3491] | 833 | !Si phase de définition.... on définit |
---|
| 834 | CALL conf_cospoutputs(var%name,var%cles) |
---|
| 835 | DO iff=1, 3 |
---|
| 836 | IF (cosp_outfilekeys(iff)) THEN |
---|
| 837 | CALL histdef2d_cosp(iff, var) |
---|
| 838 | ENDIF |
---|
| 839 | ENDDO |
---|
| 840 | !$OMP END MASTER |
---|
| 841 | ELSE |
---|
| 842 | !Et sinon on.... écrit |
---|
| 843 | IF (SIZE(field)/=klon) & |
---|
| 844 | CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1) |
---|
| 845 | |
---|
| 846 | CALL Gather_omp(field,buffer_omp) |
---|
| 847 | !$OMP MASTER |
---|
| 848 | CALL grid1Dto2D_mpi(buffer_omp,Field2d) |
---|
| 849 | |
---|
| 850 | ! La boucle sur les fichiers: |
---|
| 851 | firstx=.true. |
---|
| 852 | DO iff=1, 3 |
---|
| 853 | IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN |
---|
| 854 | ALLOCATE(index2d(nbp_lon*jj_nb)) |
---|
| 855 | deallocate(index2d) |
---|
| 856 | IF (.not. ok_all_xml) then |
---|
| 857 | if (firstx) then |
---|
| 858 | if (prt_level >= 10) then |
---|
| 859 | WRITE(lunout,*)'xios_send_field variable ',var%name |
---|
| 860 | endif |
---|
| 861 | CALL xios_send_field(var%name, Field2d) |
---|
| 862 | firstx=.false. |
---|
| 863 | endif |
---|
| 864 | ENDIF |
---|
| 865 | ENDIF |
---|
| 866 | ENDDO |
---|
| 867 | |
---|
| 868 | IF (ok_all_xml) THEN |
---|
| 869 | if (prt_level >= 1) then |
---|
| 870 | WRITE(lunout,*)'xios_send_field variable ',var%name |
---|
| 871 | endif |
---|
| 872 | CALL xios_send_field(var%name, Field2d) |
---|
| 873 | ENDIF |
---|
| 874 | |
---|
| 875 | !$OMP END MASTER |
---|
| 876 | ENDIF ! vars_defined |
---|
| 877 | IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ',var%name |
---|
| 878 | END SUBROUTINE histwrite2d_cosp |
---|
| 879 | |
---|
| 880 | |
---|
| 881 | ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE |
---|
| 882 | ! AI sept 2013 |
---|
| 883 | SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols) |
---|
| 884 | USE dimphy |
---|
| 885 | USE mod_phys_lmdz_para |
---|
| 886 | USE ioipsl |
---|
| 887 | use iophy |
---|
| 888 | USE mod_grid_phy_lmdz, ONLY: nbp_lon |
---|
| 889 | USE print_control_mod, ONLY: lunout,prt_level |
---|
| 890 | |
---|
[4727] | 891 | USE lmdz_xios, only: xios_send_field |
---|
[3491] | 892 | |
---|
| 893 | |
---|
| 894 | IMPLICIT NONE |
---|
| 895 | INCLUDE 'clesphys.h' |
---|
| 896 | |
---|
| 897 | TYPE(ctrl_outcosp), INTENT(IN) :: var |
---|
| 898 | REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:) |
---|
| 899 | INTEGER, INTENT(IN), OPTIONAL :: ncols ! ug RUSTINE POUR LES Champs 4D..... |
---|
| 900 | INTEGER, DIMENSION(3), INTENT(IN) :: nverts |
---|
| 901 | |
---|
| 902 | INTEGER :: iff, k |
---|
| 903 | |
---|
| 904 | REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp |
---|
| 905 | REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2)) |
---|
| 906 | INTEGER :: ip, n, nlev |
---|
| 907 | INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d |
---|
| 908 | CHARACTER(LEN=20) :: nomi, nom |
---|
| 909 | character(len=2) :: str2 |
---|
| 910 | LOGICAL, SAVE :: firstx |
---|
| 911 | !$OMP THREADPRIVATE(firstx) |
---|
| 912 | |
---|
| 913 | IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name |
---|
| 914 | |
---|
| 915 | ! ug RUSTINE POUR LES STD LEVS..... |
---|
| 916 | IF (PRESENT(ncols)) THEN |
---|
| 917 | write(str2,'(i2.2)')ncols |
---|
| 918 | nomi=var%name |
---|
| 919 | nom="c"//str2//"_"//nomi |
---|
| 920 | ELSE |
---|
| 921 | nom=var%name |
---|
| 922 | END IF |
---|
| 923 | ! On regarde si on est dans la phase de définition ou d'écriture: |
---|
| 924 | IF(.NOT.cosp_varsdefined) THEN |
---|
| 925 | !Si phase de définition.... on définit |
---|
| 926 | !$OMP MASTER |
---|
| 927 | CALL conf_cospoutputs(var%name,var%cles) |
---|
| 928 | DO iff=1, 3 |
---|
| 929 | IF (cosp_outfilekeys(iff)) THEN |
---|
| 930 | CALL histdef3d_cosp(iff, var, nverts(iff), ncols) |
---|
| 931 | ENDIF |
---|
| 932 | ENDDO |
---|
| 933 | !$OMP END MASTER |
---|
| 934 | ELSE |
---|
| 935 | !Et sinon on.... écrit |
---|
| 936 | IF (SIZE(field,1)/=klon) & |
---|
| 937 | CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1) |
---|
| 938 | nlev=SIZE(field,2) |
---|
| 939 | |
---|
| 940 | |
---|
| 941 | CALL Gather_omp(field,buffer_omp) |
---|
| 942 | !$OMP MASTER |
---|
| 943 | CALL grid1Dto2D_mpi(buffer_omp,field3d) |
---|
| 944 | |
---|
| 945 | ! BOUCLE SUR LES FICHIERS |
---|
| 946 | firstx=.true. |
---|
| 947 | DO iff=1, 3 |
---|
| 948 | IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN |
---|
| 949 | ALLOCATE(index3d(nbp_lon*jj_nb*nlev)) |
---|
| 950 | |
---|
| 951 | IF (.not. ok_all_xml) then |
---|
| 952 | IF (firstx) THEN |
---|
| 953 | CALL xios_send_field(nom, Field3d(:,:,1:nlev)) |
---|
| 954 | IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name |
---|
| 955 | firstx=.FALSE. |
---|
| 956 | ENDIF |
---|
| 957 | ENDIF |
---|
| 958 | deallocate(index3d) |
---|
| 959 | ENDIF |
---|
| 960 | ENDDO |
---|
| 961 | IF (ok_all_xml) THEN |
---|
| 962 | CALL xios_send_field(nom, Field3d(:,:,1:nlev)) |
---|
| 963 | IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name |
---|
| 964 | ENDIF |
---|
| 965 | |
---|
| 966 | !$OMP END MASTER |
---|
| 967 | ENDIF ! vars_defined |
---|
| 968 | IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_cosp ',nom |
---|
| 969 | END SUBROUTINE histwrite3d_cosp |
---|
| 970 | |
---|
| 971 | |
---|
| 972 | ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE |
---|
| 973 | ! AI sept 2013 |
---|
| 974 | SUBROUTINE histwrite4d_cosp(var, field) |
---|
| 975 | USE dimphy |
---|
| 976 | USE mod_phys_lmdz_para |
---|
| 977 | USE ioipsl |
---|
| 978 | use iophy |
---|
| 979 | USE mod_grid_phy_lmdz, ONLY: nbp_lon |
---|
| 980 | USE print_control_mod, ONLY: lunout,prt_level |
---|
| 981 | |
---|
[4727] | 982 | USE lmdz_xios, only: xios_send_field |
---|
[3491] | 983 | |
---|
| 984 | |
---|
| 985 | IMPLICIT NONE |
---|
| 986 | INCLUDE 'clesphys.h' |
---|
| 987 | |
---|
| 988 | TYPE(ctrl_outcosp), INTENT(IN) :: var |
---|
| 989 | REAL, DIMENSION(:,:,:), INTENT(IN) :: field ! --> field(klon,:) |
---|
| 990 | |
---|
| 991 | INTEGER :: iff, k |
---|
| 992 | |
---|
| 993 | REAL,DIMENSION(klon_mpi,SIZE(field,2),SIZE(field,3)) :: buffer_omp |
---|
| 994 | REAL :: field4d(nbp_lon,jj_nb,SIZE(field,2),SIZE(field,3)) |
---|
| 995 | INTEGER :: ip, n, nlev, nlev2 |
---|
| 996 | INTEGER, ALLOCATABLE, DIMENSION(:) :: index4d |
---|
| 997 | CHARACTER(LEN=20) :: nomi, nom |
---|
| 998 | |
---|
| 999 | IF (prt_level >= 9) write(lunout,*)'Begin histrwrite4d ',var%name |
---|
| 1000 | |
---|
| 1001 | IF(cosp_varsdefined) THEN |
---|
| 1002 | !Et sinon on.... écrit |
---|
| 1003 | IF (SIZE(field,1)/=klon) & |
---|
| 1004 | CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1) |
---|
| 1005 | |
---|
| 1006 | nlev=SIZE(field,2) |
---|
| 1007 | nlev2=SIZE(field,3) |
---|
| 1008 | CALL Gather_omp(field,buffer_omp) |
---|
| 1009 | !$OMP MASTER |
---|
| 1010 | CALL grid1Dto2D_mpi(buffer_omp,field4d) |
---|
| 1011 | |
---|
| 1012 | ! IF (ok_all_xml) THEN |
---|
| 1013 | CALL xios_send_field(var%name, Field4d(:,:,1:nlev,1:nlev2)) |
---|
| 1014 | IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name |
---|
| 1015 | ! ENDIF |
---|
| 1016 | |
---|
| 1017 | !$OMP END MASTER |
---|
| 1018 | ENDIF ! vars_defined |
---|
| 1019 | IF (prt_level >= 9) write(lunout,*)'End histrwrite4d_cosp ',nom |
---|
| 1020 | END SUBROUTINE histwrite4d_cosp |
---|
| 1021 | |
---|
| 1022 | SUBROUTINE conf_cospoutputs(nam_var,cles_var) |
---|
| 1023 | !!! Lecture des noms et cles de sortie des variables dans config.def |
---|
| 1024 | ! en utilisant les routines getin de IOIPSL |
---|
| 1025 | use ioipsl |
---|
| 1026 | USE print_control_mod, ONLY: lunout,prt_level |
---|
| 1027 | |
---|
| 1028 | IMPLICIT NONE |
---|
| 1029 | |
---|
| 1030 | CHARACTER(LEN=20) :: nam_var, nnam_var |
---|
| 1031 | LOGICAL, DIMENSION(3) :: cles_var |
---|
| 1032 | |
---|
| 1033 | ! Lecture dans config.def ou output.def de cles_var et name_var |
---|
| 1034 | CALL getin('cles_'//nam_var,cles_var) |
---|
| 1035 | CALL getin('name_'//nam_var,nam_var) |
---|
| 1036 | IF(prt_level>10) WRITE(lunout,*)'nam_var cles_var ',nam_var,cles_var(:) |
---|
| 1037 | |
---|
| 1038 | END SUBROUTINE conf_cospoutputs |
---|
| 1039 | |
---|
| 1040 | END MODULE lmdz_cosp_output_write_mod |
---|