Changeset 1260 for trunk/LMDZ.MARS/libf/aeronomars
- Timestamp:
- May 14, 2014, 3:12:01 PM (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/aeronomars/jthermcalc.F
r1238 r1260 154 154 $ h2colx(i)*crscabsi2(5,indexint) + 155 155 $ ncolx(i)*crscabsi2(9,indexint) 156 157 156 158 end do 157 159 limdown=1.e-20 158 160 limup=1.e26 159 161 160 ! Ehouarn: sanity check161 ! test that auxcolinp in monotonously increasing from 1 to nlayermx162 do j=1,nlayermx-1163 if (auxcolinp(j).gt.auxcolinp(j+1)) then164 !there is a problem165 write(*,*) "jthermcalc error: "166 write(*,*) "auxcolinp() not increasing with altitude index!"167 write(*,*) "j=",j," auxcolinp(j)=",auxcolinp(j)168 write(*,*) " auxcolinp(j+1)=",auxcolinp(j+1)169 ! Quick fix:170 if (j==1) then171 auxcolinp(j)=auxcolinp(j+1)/2.172 else173 ! compute it as a geometric mean from encompassing values174 auxcolinp(j)=sqrt(auxcolinp(j-1)*auxcolinp(j+1))175 endif176 write(*,*) " Quick fixed to auxcolinp(j)=",auxcolinp(j)177 endif178 enddo179 162 180 163 c Interpolations … … 206 189 ind=auxind(i) 207 190 auxi=nlayermx-i+1 191 ! Ehouarn: test 192 if ((ind+1.gt.nz2).or.(ind.le.0)) then 193 write(*,*) "jthercalc error: ind=",ind,ig,zenit 194 write(*,*) " auxind(1:nlayermx)=",auxind 195 write(*,*) " auxcolinp(:nlayermx)=",auxcolinp 196 write(*,*) " co2colx(:nlayermx)=",co2colx 197 write(*,*) " o2colx(:nlayermx)=",o2colx 198 write(*,*) " o3pcolx(:nlayermx)=",o3pcolx 199 write(*,*) " h2colx(:nlayermx)=",h2colx 200 write(*,*) " ncolx(:nlayermx)=",ncolx 201 write(*,*) " auxcoltab(1:nz2)=",auxcoltab 202 write(*,*) " limdown=",limdown 203 write(*,*) " limup=",limup 204 call abort_gcm('jthermcalc','error',1) 205 endif 208 206 !CO2 interpolated coefficient 209 207 jfotsout(indexint,1,auxi) = wm(i)*auxjco2(ind+1) + … … 1347 1345 end do !Of do j=1,nlayesp 1348 1346 endif !Of ilayesp(nlayesp).eq.-1 1347 1349 1348 enddo !Of do i=nlayermx,1,-1 1349 1350 1350 1351 return 1351 1352 … … 1438 1439 real*8 rkmmini ! distance zmini to center of P [km] 1439 1440 real*8 rkmj ! intermediate distance to C of P [km] 1440 1441 1441 c external function 1442 1442 external grid_R8 ! Returns index of layer containing the altitude … … 1536 1536 1537 1537 zmini=(radio+zz)*sin(szarad)-radio 1538 !zmini should be lower than zz, as SZA<90. However, in situations 1539 !where SZA is very close to 90, rounding errors can make zmini 1540 !slightly higher than zz, causing problems in the determination 1541 !of the jmin index. A correction is implemented in the determination 1542 !of jmin, some lines below 1538 1543 rkmmini = radio + zmini 1539 1544 … … 1545 1550 else 1546 1551 jmin=grid_R8(zmini,diz,nlayermx)+1 1547 1552 !Correction for possible rounding errors when SZA very close 1553 !to 90 degrees 1554 if(jmin.gt.grid_R8(zz,diz,nlayermx)) then 1555 write(*,*)'jthermcalc warning: possible rounding error' 1556 write(*,*)'point,sza,layer:',ig,szadeg,capa 1557 jmin=grid_R8(zz,diz,nlayermx) 1558 endif 1548 1559 1549 1560 if(abs(zz-diz(nlayermx)).lt.1.d-4) goto 9876 … … 1620 1631 end if 1621 1632 1633 1622 1634 return 1623 1635 … … 1652 1664 c*** CODE START 1653 1665 1654 if ( z .lt. zgrid(1) .or. z.gt.zgrid(nz)) then1666 if ( z .lt. zgrid(1) ) then 1655 1667 write (*,*) ' GRID/ z outside bounds of zgrid ' 1656 1668 write (*,*) ' z,zgrid(1),zgrid(nz) =', z,zgrid(1),zgrid(nz) 1657 stop ' Serious error in GRID.F ' 1669 z = zgrid(1) 1670 write(*,*) 'WARNING: error in grid_r8 (jthermcalc.F)' 1671 write(*,*) 'Please check values of z and zgrid above' 1672 endif 1673 if (z .gt. zgrid(nz) ) then 1674 write (*,*) ' GRID/ z outside bounds of zgrid ' 1675 write (*,*) ' z,zgrid(1),zgrid(nz) =', z,zgrid(1),zgrid(nz) 1676 z = zgrid(nz) 1677 write(*,*) 'WARNING: error in grid_r8 (jthermcalc.F)' 1678 write(*,*) 'Please check values of z and zgrid above' 1658 1679 endif 1659 1680 if ( nz .lt. 2 ) then
Note: See TracChangeset
for help on using the changeset viewer.