- Timestamp:
- Aug 2, 2024, 2:12:03 PM (3 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ifs_rrtm.F90
r4489 r5158 362 362 ! end if 363 363 364 dojlev=1,nlev365 dojcol= istartcol,iendcol364 DO jlev=1,nlev 365 DO jcol= istartcol,iendcol 366 366 pressure_fl(jcol,jlev) & 367 367 & = 0.5_jprb * (thermodynamics%pressure_hl(jcol,jlev+istartlev-1) & … … 461 461 ! arrays have dimensions in a different order to the inputs, 462 462 ! so there is some inefficiency here. 463 dojgreorder = 1,config%n_g_lw463 DO jgreorder = 1,config%n_g_lw 464 464 iband = config%i_band_from_reordered_g_lw(jgreorder) 465 465 ig = config%i_g_from_reordered_g_lw(jgreorder) 466 466 467 467 ! Top-of-atmosphere half level 468 dojlev = 1,nlev469 dojcol = istartcol,iendcol468 DO jlev = 1,nlev 469 DO jcol = istartcol,iendcol 470 470 ! Some g points can return negative optical depths; 471 471 ! specifically original g points 54-56 which causes … … 479 479 else 480 480 ! G points have not been reordered 481 dojcol = istartcol,iendcol482 dojlev = 1,nlev481 DO jcol = istartcol,iendcol 482 DO jlev = 1,nlev 483 483 ! Check for negative optical depth 484 484 od_lw(:,jlev,jcol) = max(config%min_gas_od_lw, ZOD_LW(:,nlev+1-jlev,jcol)) … … 515 515 ! Scale the incoming solar per band, if requested 516 516 if (config%use_spectral_solar_scaling) then 517 dojg = 1,JPGPT_SW518 do jcol = istartcol,iendcol517 DO jg = 1,JPGPT_SW 518 DO jcol = istartcol,iendcol 519 519 ZINCSOL(jcol,jg) = ZINCSOL(jcol,jg) * & 520 520 & single_level%spectral_solar_scaling(config%i_band_from_reordered_g_sw(jg)) … … 527 527 ! ZINCSOL will be zero. 528 528 if (present(incoming_sw)) then 529 dojcol = istartcol,iendcol529 DO jcol = istartcol,iendcol 530 530 if (single_level%cos_sza(jcol) > 0.0_jprb) then 531 531 ! Added for DWD (2020) … … 541 541 ! if (.true.) then 542 542 ! Account for reordered g points 543 dojgreorder = 1,config%n_g_sw543 DO jgreorder = 1,config%n_g_sw 544 544 ig = config%i_g_from_reordered_g_sw(jgreorder) 545 dojlev = 1,nlev546 dojcol = istartcol,iendcol545 DO jlev = 1,nlev 546 DO jcol = istartcol,iendcol 547 547 ! Check for negative optical depth 548 548 od_sw (jgreorder,nlev+1-jlev,jcol) & … … 558 558 else 559 559 ! G points have not been reordered 560 dojcol = istartcol,iendcol561 dojlev = 1,nlev562 dojg = 1,config%n_g_sw560 DO jcol = istartcol,iendcol 561 DO jlev = 1,nlev 562 DO jg = 1,config%n_g_sw 563 563 ! Check for negative optical depth 564 564 od_sw (jg,nlev+1-jlev,jcol) = max(config%min_gas_od_sw, ZOD_SW(jcol,jlev,jg)) … … 567 567 end do 568 568 if (present(incoming_sw)) then 569 dojg = 1,config%n_g_sw569 DO jg = 1,config%n_g_sw 570 570 incoming_sw(jg,jcol) = incoming_sw_scale(jcol) * ZINCSOL(jcol,jg) 571 571 end do … … 636 636 ! lowest interpolation bound, and the fraction into interpolation 637 637 ! interval 638 dojlev = 1,nlev+1639 dojcol = istartcol,iendcol638 DO jlev = 1,nlev+1 639 DO jcol = istartcol,iendcol 640 640 temperature = thermodynamics%temperature_hl(jcol,jlev+ilevoffset) 641 641 if (temperature < 339.0_jprb .and. temperature >= 160.0_jprb) then … … 656 656 657 657 ! Calculate Planck functions per band 658 dojband = 1,config%n_bands_lw658 DO jband = 1,config%n_bands_lw 659 659 factor = zfluxfac * delwave(jband) 660 dojcol = istartcol,iendcol660 DO jcol = istartcol,iendcol 661 661 planck_store(jcol,jband) = factor & 662 662 & * (totplnk(ind(jcol),jband) & … … 675 675 ! Top-of-atmosphere half level - note that PFRAC is on model 676 676 ! levels not half levels 677 dojgreorder = 1,config%n_g_lw677 DO jgreorder = 1,config%n_g_lw 678 678 iband = config%i_band_from_reordered_g_lw(jgreorder) 679 679 ig = config%i_g_from_reordered_g_lw(jgreorder) … … 682 682 end do 683 683 else 684 dojgreorder = 1,config%n_g_lw684 DO jgreorder = 1,config%n_g_lw 685 685 iband = config%i_band_from_reordered_g_lw(jgreorder) 686 686 ig = config%i_g_from_reordered_g_lw(jgreorder) … … 695 695 ! Top-of-atmosphere half level - note that PFRAC is on model 696 696 ! levels not half levels 697 dojg = 1,config%n_g_lw697 DO jg = 1,config%n_g_lw 698 698 iband = config%i_band_from_g_lw(jg) 699 699 planck_hl(jg,1,:) = planck_store(:,iband) * PFRAC(:,jg,nlev) 700 700 end do 701 701 else 702 dojg = 1,config%n_g_lw702 DO jg = 1,config%n_g_lw 703 703 iband = config%i_band_from_g_lw(jg) 704 704 planck_tmp(:,jg) = planck_store(:,iband) * PFRAC(:,jg,nlev+2-jlev) 705 705 end do 706 dojcol = istartcol,iendcol706 DO jcol = istartcol,iendcol 707 707 planck_hl(:,jlev,jcol) = planck_tmp(jcol,:) 708 708 end do … … 763 763 764 764 ! Work out surface interpolations 765 dojcol = istartcol,iendcol765 DO jcol = istartcol,iendcol 766 766 Tsurf = temperature(jcol) 767 767 if (Tsurf < 339.0_jprb .and. Tsurf >= 160.0_jprb) then … … 782 782 783 783 ! Calculate Planck functions per band 784 dojband = 1,config%n_bands_lw784 DO jband = 1,config%n_bands_lw 785 785 factor = zfluxfac * delwave(jband) 786 dojcol = istartcol,iendcol786 DO jcol = istartcol,iendcol 787 787 planck_store(jcol,jband) = factor & 788 788 & * (totplnk(ind(jcol),jband) & … … 798 798 ! in pressure since the the functions above treat pressure 799 799 ! decreasing with increasing index. 800 dojgreorder = 1,config%n_g_lw800 DO jgreorder = 1,config%n_g_lw 801 801 iband = config%i_band_from_reordered_g_lw(jgreorder) 802 802 ig = config%i_g_from_reordered_g_lw(jgreorder) … … 805 805 else 806 806 ! G points have not been reordered 807 dojg = 1,config%n_g_lw807 DO jg = 1,config%n_g_lw 808 808 iband = config%i_band_from_g_lw(jg) 809 809 planck_surf(jg,:) = planck_store(:,iband) * PFRAC(:,jg)
Note: See TracChangeset
for help on using the changeset viewer.