| Line |
Branch |
Exec |
Source |
| 1 |
|
✗ |
subroutine check_isotopes_seq(q,ip1jmp1,err_msg) |
| 2 |
|
|
USE infotrac |
| 3 |
|
|
implicit none |
| 4 |
|
|
|
| 5 |
|
|
!----------------------------------------------------------------------- |
| 6 |
|
|
! INCLUDE 'dimensions.h' |
| 7 |
|
|
! |
| 8 |
|
|
! dimensions.h contient les dimensions du modele |
| 9 |
|
|
! ndm est tel que iim=2**ndm |
| 10 |
|
|
!----------------------------------------------------------------------- |
| 11 |
|
|
|
| 12 |
|
|
INTEGER iim,jjm,llm,ndm |
| 13 |
|
|
|
| 14 |
|
|
PARAMETER (iim= 32,jjm=32,llm=39,ndm=1) |
| 15 |
|
|
|
| 16 |
|
|
!----------------------------------------------------------------------- |
| 17 |
|
|
|
| 18 |
|
|
! inputs |
| 19 |
|
|
integer ip1jmp1 |
| 20 |
|
|
real q(ip1jmp1,llm,nqtot) |
| 21 |
|
|
character*(*) err_msg ! message d''erreur à afficher |
| 22 |
|
|
|
| 23 |
|
|
! locals |
| 24 |
|
|
integer ixt,phase,k,i,iq,iiso,izone,ieau,iqeau |
| 25 |
|
|
real xtractot,xiiso |
| 26 |
|
|
real borne |
| 27 |
|
|
real qmin |
| 28 |
|
|
real errmax ! erreur maximale en absolu. |
| 29 |
|
|
real errmaxrel ! erreur maximale en relatif autorisée |
| 30 |
|
|
real deltaDmax,deltaDmin |
| 31 |
|
|
real ridicule |
| 32 |
|
|
parameter (borne=1e19) |
| 33 |
|
|
parameter (errmax=1e-8) |
| 34 |
|
|
parameter (errmaxrel=1e-3) |
| 35 |
|
|
parameter (qmin=1e-11) |
| 36 |
|
|
parameter (deltaDmax=200.0,deltaDmin=-999.9) |
| 37 |
|
|
parameter (ridicule=1e-12) |
| 38 |
|
|
real deltaD |
| 39 |
|
|
|
| 40 |
|
✗ |
if (ok_isotopes) then |
| 41 |
|
|
|
| 42 |
|
✗ |
write(*,*) 'check_isotopes 31: err_msg=',err_msg |
| 43 |
|
|
! verifier que rien n'est NaN |
| 44 |
|
✗ |
do ixt=1,ntraciso |
| 45 |
|
✗ |
do phase=1,nqo |
| 46 |
|
✗ |
iq=iqiso(ixt,phase) |
| 47 |
|
✗ |
do k=1,llm |
| 48 |
|
✗ |
DO i = 1,ip1jmp1 |
| 49 |
|
✗ |
if ((q(i,k,iq).gt.-borne).and. |
| 50 |
|
✗ |
: (q(i,k,iq).lt.borne)) then |
| 51 |
|
|
else !if ((x(ixt,i,j).gt.-borne).and. |
| 52 |
|
✗ |
write(*,*) 'erreur detectee par iso_verif_noNaN:' |
| 53 |
|
✗ |
write(*,*) err_msg |
| 54 |
|
✗ |
write(*,*) 'q,i,k,iq=',q(i,k,iq),i,k,iq |
| 55 |
|
✗ |
write(*,*) 'borne=',borne |
| 56 |
|
✗ |
stop |
| 57 |
|
|
endif !if ((x(ixt,i,j).gt.-borne).and. |
| 58 |
|
|
enddo !DO i = 1,ip1jmp1 |
| 59 |
|
|
enddo !do k=1,llm |
| 60 |
|
|
enddo !do phase=1,nqo |
| 61 |
|
|
enddo !do ixt=1,ntraciso |
| 62 |
|
|
|
| 63 |
|
|
!write(*,*) 'check_isotopes 52' |
| 64 |
|
|
! verifier que l'eau normale est OK |
| 65 |
|
✗ |
if (use_iso(1)) then |
| 66 |
|
✗ |
ixt=indnum_fn_num(1) |
| 67 |
|
✗ |
do phase=1,nqo |
| 68 |
|
✗ |
iq=iqiso(ixt,phase) |
| 69 |
|
✗ |
do k=1,llm |
| 70 |
|
✗ |
DO i = 1,ip1jmp1 |
| 71 |
|
✗ |
if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and. |
| 72 |
|
|
: (abs((q(i,k,phase)-q(i,k,iq))/ |
| 73 |
|
|
: max(max(abs(q(i,k,phase)),abs(q(i,k,iq))),1e-18)) |
| 74 |
|
|
: .gt.errmaxrel)) then |
| 75 |
|
✗ |
write(*,*) 'erreur detectee par iso_verif_egalite:' |
| 76 |
|
✗ |
write(*,*) err_msg |
| 77 |
|
✗ |
write(*,*) 'ixt,phase=',ixt,phase |
| 78 |
|
✗ |
write(*,*) 'q,iq,i,k=',q(i,k,iq),iq,i,k |
| 79 |
|
✗ |
write(*,*) 'q(i,k,phase)=',q(i,k,phase) |
| 80 |
|
✗ |
stop |
| 81 |
|
|
endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and. |
| 82 |
|
|
! bidouille pour éviter divergence: |
| 83 |
|
✗ |
q(i,k,iq)= q(i,k,phase) |
| 84 |
|
|
enddo ! DO i = 1,ip1jmp1 |
| 85 |
|
|
enddo !do k=1,llm |
| 86 |
|
|
enddo ! do phase=1,nqo |
| 87 |
|
|
endif !if (use_iso(1)) then |
| 88 |
|
|
|
| 89 |
|
|
!write(*,*) 'check_isotopes 78' |
| 90 |
|
|
! verifier que HDO est raisonable |
| 91 |
|
✗ |
if (use_iso(2)) then |
| 92 |
|
✗ |
ixt=indnum_fn_num(2) |
| 93 |
|
✗ |
do phase=1,nqo |
| 94 |
|
✗ |
iq=iqiso(ixt,phase) |
| 95 |
|
✗ |
do k=1,llm |
| 96 |
|
✗ |
DO i = 1,ip1jmp1 |
| 97 |
|
✗ |
if (q(i,k,iq).gt.qmin) then |
| 98 |
|
✗ |
deltaD=(q(i,k,iq)/q(i,k,phase)/tnat(2)-1)*1000 |
| 99 |
|
✗ |
if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then |
| 100 |
|
✗ |
write(*,*) 'erreur detectee par iso_verif_aberrant:' |
| 101 |
|
✗ |
write(*,*) err_msg |
| 102 |
|
✗ |
write(*,*) 'ixt,phase=',ixt,phase |
| 103 |
|
✗ |
write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k |
| 104 |
|
✗ |
write(*,*) 'q=',q(i,k,:) |
| 105 |
|
✗ |
write(*,*) 'deltaD=',deltaD |
| 106 |
|
✗ |
stop |
| 107 |
|
|
endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then |
| 108 |
|
|
endif !if (q(i,k,iq).gt.qmin) then |
| 109 |
|
|
enddo !DO i = 1,ip1jmp1 |
| 110 |
|
|
enddo !do k=1,llm |
| 111 |
|
|
enddo ! do phase=1,nqo |
| 112 |
|
|
endif !if (use_iso(2)) then |
| 113 |
|
|
|
| 114 |
|
|
!write(*,*) 'check_isotopes 103' |
| 115 |
|
|
! verifier que O18 est raisonable |
| 116 |
|
✗ |
if (use_iso(3)) then |
| 117 |
|
✗ |
ixt=indnum_fn_num(3) |
| 118 |
|
✗ |
do phase=1,nqo |
| 119 |
|
✗ |
iq=iqiso(ixt,phase) |
| 120 |
|
✗ |
do k=1,llm |
| 121 |
|
✗ |
DO i = 1,ip1jmp1 |
| 122 |
|
✗ |
if (q(i,k,iq).gt.qmin) then |
| 123 |
|
✗ |
deltaD=(q(i,k,iq)/q(i,k,phase)/tnat(3)-1)*1000 |
| 124 |
|
✗ |
if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then |
| 125 |
|
✗ |
write(*,*) 'erreur detectee iso_verif_aberrant O18:' |
| 126 |
|
✗ |
write(*,*) err_msg |
| 127 |
|
✗ |
write(*,*) 'ixt,phase=',ixt,phase |
| 128 |
|
✗ |
write(*,*) 'q,iq,i,k,=',q(i,k,phase),iq,i,k |
| 129 |
|
✗ |
write(*,*) 'xt=',q(i,k,:) |
| 130 |
|
✗ |
write(*,*) 'deltaO18=',deltaD |
| 131 |
|
✗ |
stop |
| 132 |
|
|
endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then |
| 133 |
|
|
endif !if (q(i,k,iq).gt.qmin) then |
| 134 |
|
|
enddo !DO i = 1,ip1jmp1 |
| 135 |
|
|
enddo !do k=1,llm |
| 136 |
|
|
enddo ! do phase=1,nqo |
| 137 |
|
|
endif !if (use_iso(2)) then |
| 138 |
|
|
|
| 139 |
|
|
|
| 140 |
|
|
!write(*,*) 'check_isotopes 129' |
| 141 |
|
✗ |
if (ok_isotrac) then |
| 142 |
|
|
|
| 143 |
|
✗ |
if (use_iso(2).and.use_iso(1)) then |
| 144 |
|
✗ |
do izone=1,ntraceurs_zone |
| 145 |
|
✗ |
ixt=index_trac(izone,indnum_fn_num(2)) |
| 146 |
|
✗ |
ieau=index_trac(izone,indnum_fn_num(1)) |
| 147 |
|
✗ |
do phase=1,nqo |
| 148 |
|
✗ |
iq=iqiso(ixt,phase) |
| 149 |
|
✗ |
iqeau=iqiso(ieau,phase) |
| 150 |
|
✗ |
do k=1,llm |
| 151 |
|
✗ |
DO i = 1,ip1jmp1 |
| 152 |
|
✗ |
if (q(i,k,iq).gt.qmin) then |
| 153 |
|
✗ |
deltaD=(q(i,k,iq)/q(i,k,iqeau)/tnat(2)-1)*1000 |
| 154 |
|
✗ |
if ((deltaD.gt.deltaDmax).or. |
| 155 |
|
|
& (deltaD.lt.deltaDmin)) then |
| 156 |
|
✗ |
write(*,*) 'erreur dans iso_verif_aberrant trac:' |
| 157 |
|
✗ |
write(*,*) err_msg |
| 158 |
|
✗ |
write(*,*) 'izone,phase=',izone,phase |
| 159 |
|
✗ |
write(*,*) 'ixt,ieau=',ixt,ieau |
| 160 |
|
✗ |
write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k |
| 161 |
|
✗ |
write(*,*) 'deltaD=',deltaD |
| 162 |
|
✗ |
stop |
| 163 |
|
|
endif !if ((deltaD.gt.deltaDmax).or. |
| 164 |
|
|
endif !if (q(i,k,iq).gt.qmin) then |
| 165 |
|
|
enddo !DO i = 1,ip1jmp1 |
| 166 |
|
|
enddo ! do k=1,llm |
| 167 |
|
|
enddo ! do phase=1,nqo |
| 168 |
|
|
enddo !do izone=1,ntraceurs_zone |
| 169 |
|
|
endif !if (use_iso(2).and.use_iso(1)) then |
| 170 |
|
|
|
| 171 |
|
✗ |
do iiso=1,niso |
| 172 |
|
✗ |
do phase=1,nqo |
| 173 |
|
✗ |
iq=iqiso(iiso,phase) |
| 174 |
|
✗ |
do k=1,llm |
| 175 |
|
✗ |
DO i = 1,ip1jmp1 |
| 176 |
|
|
xtractot=0.0 |
| 177 |
|
✗ |
xiiso=q(i,k,iq) |
| 178 |
|
✗ |
do izone=1,ntraceurs_zone |
| 179 |
|
✗ |
iq=iqiso(index_trac(izone,iiso),phase) |
| 180 |
|
✗ |
xtractot=xtractot+ q(i,k,iq) |
| 181 |
|
|
enddo !do izone=1,ntraceurs_zone |
| 182 |
|
✗ |
if ((abs(xtractot-xiiso).gt.errmax).and. |
| 183 |
|
|
: (abs(xtractot-xiiso)/ |
| 184 |
|
|
: max(max(abs(xtractot),abs(xiiso)),1e-18) |
| 185 |
|
✗ |
: .gt.errmaxrel)) then |
| 186 |
|
✗ |
write(*,*) 'erreur detectee par iso_verif_traceurs:' |
| 187 |
|
✗ |
write(*,*) err_msg |
| 188 |
|
✗ |
write(*,*) 'iiso,phase=',iiso,phase |
| 189 |
|
✗ |
write(*,*) 'i,k,=',i,k |
| 190 |
|
✗ |
write(*,*) 'q(i,k,:)=',q(i,k,:) |
| 191 |
|
✗ |
stop |
| 192 |
|
|
endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and. |
| 193 |
|
|
|
| 194 |
|
|
! bidouille pour éviter divergence: |
| 195 |
|
✗ |
if (abs(xtractot).gt.ridicule) then |
| 196 |
|
✗ |
do izone=1,ntraceurs_zone |
| 197 |
|
✗ |
ixt=index_trac(izone,iiso) |
| 198 |
|
✗ |
q(i,k,iq)=q(i,k,iq)/xtractot*xiiso |
| 199 |
|
|
enddo !do izone=1,ntraceurs_zone |
| 200 |
|
|
endif !if ((abs(xtractot).gt.ridicule) then |
| 201 |
|
|
enddo !DO i = 1,ip1jmp1 |
| 202 |
|
|
enddo !do k=1,llm |
| 203 |
|
|
enddo !do phase=1,nqo |
| 204 |
|
|
enddo !do iiso=1,niso |
| 205 |
|
|
|
| 206 |
|
|
endif !if (ok_isotrac) then |
| 207 |
|
|
|
| 208 |
|
|
endif ! if (ok_isotopes) |
| 209 |
|
|
!write(*,*) 'check_isotopes 198' |
| 210 |
|
|
|
| 211 |
|
✗ |
end |
| 212 |
|
|
|
| 213 |
|
|
|