Changeset 3004 for palm/trunk/SOURCE/radiation_model_mod.f90
 Timestamp:
 Apr 27, 2018 12:33:25 PM (3 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

palm/trunk/SOURCE/radiation_model_mod.f90
r2995 r3004 28 28 !  29 29 ! $Id$ 30 ! Further allocation checks implemented (averaged data will be assigned to fill 31 ! values if no allocation happened so far) 32 ! 33 ! 2995 20180419 12:13:16Z Giersch 30 34 ! IFstatement in radiation_init removed so that the calculation of radiative 31 35 ! fluxes at model start is done in any case, bugfix in … … 7323 7327 7324 7328 CASE ( 'rad_net*' ) 7325 DO i = nxl, nxr 7326 DO j = nys, nyn 7327 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 7328 rad_net_av(j,i) = rad_net_av(j,i) + surf_lsm_h%rad_net(m) 7329 ENDDO 7330 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 7331 rad_net_av(j,i) = rad_net_av(j,i) + surf_usm_h%rad_net(m) 7329 IF ( ALLOCATED( rad_net_av ) ) THEN 7330 DO i = nxl, nxr 7331 DO j = nys, nyn 7332 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 7333 rad_net_av(j,i) = rad_net_av(j,i) + surf_lsm_h%rad_net(m) 7334 ENDDO 7335 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 7336 rad_net_av(j,i) = rad_net_av(j,i) + surf_usm_h%rad_net(m) 7337 ENDDO 7332 7338 ENDDO 7333 7339 ENDDO 7334 END DO7340 ENDIF 7335 7341 7336 7342 CASE ( 'rad_lw_in' ) 7337 DO i = nxlg, nxrg 7338 DO j = nysg, nyng 7339 DO k = nzb, nzt+1 7340 rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) + rad_lw_in(k,j,i) 7343 IF ( ALLOCATED( rad_lw_in_av ) ) THEN 7344 DO i = nxlg, nxrg 7345 DO j = nysg, nyng 7346 DO k = nzb, nzt+1 7347 rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) & 7348 + rad_lw_in(k,j,i) 7349 ENDDO 7341 7350 ENDDO 7342 7351 ENDDO 7343 END DO7352 ENDIF 7344 7353 7345 7354 CASE ( 'rad_lw_out' ) 7346 DO i = nxlg, nxrg 7347 DO j = nysg, nyng 7348 DO k = nzb, nzt+1 7349 rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) & 7350 + rad_lw_out(k,j,i) 7355 IF ( ALLOCATED( rad_lw_out_av ) ) THEN 7356 DO i = nxlg, nxrg 7357 DO j = nysg, nyng 7358 DO k = nzb, nzt+1 7359 rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) & 7360 + rad_lw_out(k,j,i) 7361 ENDDO 7351 7362 ENDDO 7352 7363 ENDDO 7353 END DO7364 ENDIF 7354 7365 7355 7366 CASE ( 'rad_lw_cs_hr' ) 7356 DO i = nxlg, nxrg 7357 DO j = nysg, nyng 7358 DO k = nzb, nzt+1 7359 rad_lw_cs_hr_av(k,j,i) = rad_lw_cs_hr_av(k,j,i) & 7360 + rad_lw_cs_hr(k,j,i) 7367 IF ( ALLOCATED( rad_lw_cs_hr_av ) ) THEN 7368 DO i = nxlg, nxrg 7369 DO j = nysg, nyng 7370 DO k = nzb, nzt+1 7371 rad_lw_cs_hr_av(k,j,i) = rad_lw_cs_hr_av(k,j,i) & 7372 + rad_lw_cs_hr(k,j,i) 7373 ENDDO 7361 7374 ENDDO 7362 7375 ENDDO 7363 END DO7376 ENDIF 7364 7377 7365 7378 CASE ( 'rad_lw_hr' ) 7366 DO i = nxlg, nxrg 7367 DO j = nysg, nyng 7368 DO k = nzb, nzt+1 7369 rad_lw_hr_av(k,j,i) = rad_lw_hr_av(k,j,i) & 7370 + rad_lw_hr(k,j,i) 7379 IF ( ALLOCATED( rad_lw_hr_av ) ) THEN 7380 DO i = nxlg, nxrg 7381 DO j = nysg, nyng 7382 DO k = nzb, nzt+1 7383 rad_lw_hr_av(k,j,i) = rad_lw_hr_av(k,j,i) & 7384 + rad_lw_hr(k,j,i) 7385 ENDDO 7371 7386 ENDDO 7372 7387 ENDDO 7373 END DO7388 ENDIF 7374 7389 7375 7390 CASE ( 'rad_sw_in' ) 7376 DO i = nxlg, nxrg 7377 DO j = nysg, nyng 7378 DO k = nzb, nzt+1 7379 rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) & 7380 + rad_sw_in(k,j,i) 7391 IF ( ALLOCATED( rad_sw_in_av ) ) THEN 7392 DO i = nxlg, nxrg 7393 DO j = nysg, nyng 7394 DO k = nzb, nzt+1 7395 rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) & 7396 + rad_sw_in(k,j,i) 7397 ENDDO 7381 7398 ENDDO 7382 7399 ENDDO 7383 END DO7400 ENDIF 7384 7401 7385 7402 CASE ( 'rad_sw_out' ) 7386 DO i = nxlg, nxrg 7387 DO j = nysg, nyng 7388 DO k = nzb, nzt+1 7389 rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) & 7390 + rad_sw_out(k,j,i) 7403 IF ( ALLOCATED( rad_sw_out_av ) ) THEN 7404 DO i = nxlg, nxrg 7405 DO j = nysg, nyng 7406 DO k = nzb, nzt+1 7407 rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) & 7408 + rad_sw_out(k,j,i) 7409 ENDDO 7391 7410 ENDDO 7392 7411 ENDDO 7393 END DO7412 ENDIF 7394 7413 7395 7414 CASE ( 'rad_sw_cs_hr' ) 7396 DO i = nxlg, nxrg 7397 DO j = nysg, nyng 7398 DO k = nzb, nzt+1 7399 rad_sw_cs_hr_av(k,j,i) = rad_sw_cs_hr_av(k,j,i) & 7400 + rad_sw_cs_hr(k,j,i) 7415 IF ( ALLOCATED( rad_sw_cs_hr_av ) ) THEN 7416 DO i = nxlg, nxrg 7417 DO j = nysg, nyng 7418 DO k = nzb, nzt+1 7419 rad_sw_cs_hr_av(k,j,i) = rad_sw_cs_hr_av(k,j,i) & 7420 + rad_sw_cs_hr(k,j,i) 7421 ENDDO 7401 7422 ENDDO 7402 7423 ENDDO 7403 END DO7424 ENDIF 7404 7425 7405 7426 CASE ( 'rad_sw_hr' ) 7406 DO i = nxlg, nxrg 7407 DO j = nysg, nyng 7408 DO k = nzb, nzt+1 7409 rad_sw_hr_av(k,j,i) = rad_sw_hr_av(k,j,i) & 7410 + rad_sw_hr(k,j,i) 7427 IF ( ALLOCATED( rad_sw_hr_av ) ) THEN 7428 DO i = nxlg, nxrg 7429 DO j = nysg, nyng 7430 DO k = nzb, nzt+1 7431 rad_sw_hr_av(k,j,i) = rad_sw_hr_av(k,j,i) & 7432 + rad_sw_hr(k,j,i) 7433 ENDDO 7411 7434 ENDDO 7412 7435 ENDDO 7413 END DO7436 ENDIF 7414 7437 7415 7438 CASE DEFAULT … … 7423 7446 7424 7447 CASE ( 'rad_net*' ) 7425 DO i = nxlg, nxrg 7426 DO j = nysg, nyng 7427 rad_net_av(j,i) = rad_net_av(j,i) / REAL( average_count_3d, & 7428 KIND=wp ) 7429 ENDDO 7430 ENDDO 7431 7432 CASE ( 'rad_lw_in' ) 7433 DO i = nxlg, nxrg 7434 DO j = nysg, nyng 7435 DO k = nzb, nzt+1 7436 rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) & 7437 / REAL( average_count_3d, KIND=wp ) 7448 IF ( ALLOCATED( rad_net_av ) ) THEN 7449 DO i = nxlg, nxrg 7450 DO j = nysg, nyng 7451 rad_net_av(j,i) = rad_net_av(j,i) & 7452 / REAL( average_count_3d, KIND=wp ) 7438 7453 ENDDO 7439 7454 ENDDO 7440 ENDDO 7441 7442 CASE ( 'rad_lw_out' ) 7443 DO i = nxlg, nxrg 7444 DO j = nysg, nyng 7445 DO k = nzb, nzt+1 7446 rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) & 7447 / REAL( average_count_3d, KIND=wp ) 7455 ENDIF 7456 7457 CASE ( 'rad_lw_in' ) 7458 IF ( ALLOCATED( rad_lw_in_av ) ) THEN 7459 DO i = nxlg, nxrg 7460 DO j = nysg, nyng 7461 DO k = nzb, nzt+1 7462 rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) & 7463 / REAL( average_count_3d, KIND=wp ) 7464 ENDDO 7448 7465 ENDDO 7449 7466 ENDDO 7450 ENDDO 7451 7452 CASE ( 'rad_lw_cs_hr' ) 7453 DO i = nxlg, nxrg 7454 DO j = nysg, nyng 7455 DO k = nzb, nzt+1 7456 rad_lw_cs_hr_av(k,j,i) = rad_lw_cs_hr_av(k,j,i) & 7457 / REAL( average_count_3d, KIND=wp ) 7467 ENDIF 7468 7469 CASE ( 'rad_lw_out' ) 7470 IF ( ALLOCATED( rad_lw_out_av ) ) THEN 7471 DO i = nxlg, nxrg 7472 DO j = nysg, nyng 7473 DO k = nzb, nzt+1 7474 rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) & 7475 / REAL( average_count_3d, KIND=wp ) 7476 ENDDO 7458 7477 ENDDO 7459 7478 ENDDO 7460 ENDDO 7461 7462 CASE ( 'rad_lw_hr' ) 7463 DO i = nxlg, nxrg 7464 DO j = nysg, nyng 7465 DO k = nzb, nzt+1 7466 rad_lw_hr_av(k,j,i) = rad_lw_hr_av(k,j,i) & 7467 / REAL( average_count_3d, KIND=wp ) 7479 ENDIF 7480 7481 CASE ( 'rad_lw_cs_hr' ) 7482 IF ( ALLOCATED( rad_lw_cs_hr_av ) ) THEN 7483 DO i = nxlg, nxrg 7484 DO j = nysg, nyng 7485 DO k = nzb, nzt+1 7486 rad_lw_cs_hr_av(k,j,i) = rad_lw_cs_hr_av(k,j,i) & 7487 / REAL( average_count_3d, KIND=wp ) 7488 ENDDO 7468 7489 ENDDO 7469 7490 ENDDO 7470 ENDDO 7471 7472 CASE ( 'rad_sw_in' ) 7473 DO i = nxlg, nxrg 7474 DO j = nysg, nyng 7475 DO k = nzb, nzt+1 7476 rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) & 7477 / REAL( average_count_3d, KIND=wp ) 7491 ENDIF 7492 7493 CASE ( 'rad_lw_hr' ) 7494 IF ( ALLOCATED( rad_lw_hr_av ) ) THEN 7495 DO i = nxlg, nxrg 7496 DO j = nysg, nyng 7497 DO k = nzb, nzt+1 7498 rad_lw_hr_av(k,j,i) = rad_lw_hr_av(k,j,i) & 7499 / REAL( average_count_3d, KIND=wp ) 7500 ENDDO 7478 7501 ENDDO 7479 7502 ENDDO 7480 ENDDO 7481 7482 CASE ( 'rad_sw_out' ) 7483 DO i = nxlg, nxrg 7484 DO j = nysg, nyng 7485 DO k = nzb, nzt+1 7486 rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) & 7487 / REAL( average_count_3d, KIND=wp ) 7503 ENDIF 7504 7505 CASE ( 'rad_sw_in' ) 7506 IF ( ALLOCATED( rad_sw_in_av ) ) THEN 7507 DO i = nxlg, nxrg 7508 DO j = nysg, nyng 7509 DO k = nzb, nzt+1 7510 rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) & 7511 / REAL( average_count_3d, KIND=wp ) 7512 ENDDO 7488 7513 ENDDO 7489 7514 ENDDO 7490 ENDDO 7491 7492 CASE ( 'rad_sw_cs_hr' ) 7493 DO i = nxlg, nxrg 7494 DO j = nysg, nyng 7495 DO k = nzb, nzt+1 7496 rad_sw_cs_hr_av(k,j,i) = rad_sw_cs_hr_av(k,j,i) & 7497 / REAL( average_count_3d, KIND=wp ) 7515 ENDIF 7516 7517 CASE ( 'rad_sw_out' ) 7518 IF ( ALLOCATED( rad_sw_out_av ) ) THEN 7519 DO i = nxlg, nxrg 7520 DO j = nysg, nyng 7521 DO k = nzb, nzt+1 7522 rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) & 7523 / REAL( average_count_3d, KIND=wp ) 7524 ENDDO 7498 7525 ENDDO 7499 7526 ENDDO 7500 ENDDO 7501 7502 CASE ( 'rad_sw_hr' ) 7503 DO i = nxlg, nxrg 7504 DO j = nysg, nyng 7505 DO k = nzb, nzt+1 7506 rad_sw_hr_av(k,j,i) = rad_sw_hr_av(k,j,i) & 7507 / REAL( average_count_3d, KIND=wp ) 7527 ENDIF 7528 7529 CASE ( 'rad_sw_cs_hr' ) 7530 IF ( ALLOCATED( rad_sw_cs_hr_av ) ) THEN 7531 DO i = nxlg, nxrg 7532 DO j = nysg, nyng 7533 DO k = nzb, nzt+1 7534 rad_sw_cs_hr_av(k,j,i) = rad_sw_cs_hr_av(k,j,i) & 7535 / REAL( average_count_3d, KIND=wp ) 7536 ENDDO 7508 7537 ENDDO 7509 7538 ENDDO 7510 ENDDO 7539 ENDIF 7540 7541 CASE ( 'rad_sw_hr' ) 7542 IF ( ALLOCATED( rad_sw_hr_av ) ) THEN 7543 DO i = nxlg, nxrg 7544 DO j = nysg, nyng 7545 DO k = nzb, nzt+1 7546 rad_sw_hr_av(k,j,i) = rad_sw_hr_av(k,j,i) & 7547 / REAL( average_count_3d, KIND=wp ) 7548 ENDDO 7549 ENDDO 7550 ENDDO 7551 ENDIF 7511 7552 7512 7553 END SELECT … … 7598 7639 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) 7599 7640 7641 REAL(wp) :: fill_value = 999.0_wp !< value for the _FillValue attribute 7642 7600 7643 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !< 7601 7644 … … 7624 7667 ENDDO 7625 7668 ELSE 7669 IF ( .NOT. ALLOCATED( rad_net_av ) ) THEN 7670 ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) ) 7671 rad_net_av = REAL( fill_value, KIND = wp ) 7672 ENDIF 7626 7673 DO i = nxl, nxr 7627 7674 DO j = nys, nyn … … 7644 7691 ENDDO 7645 7692 ELSE 7693 IF ( .NOT. ALLOCATED( rad_lw_in_av ) ) THEN 7694 ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 7695 rad_lw_in_av = REAL( fill_value, KIND = wp ) 7696 ENDIF 7646 7697 DO i = nxl, nxr 7647 7698 DO j = nys, nyn … … 7664 7715 ENDDO 7665 7716 ELSE 7717 IF ( .NOT. ALLOCATED( rad_lw_out_av ) ) THEN 7718 ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 7719 rad_lw_out_av = REAL( fill_value, KIND = wp ) 7720 ENDIF 7666 7721 DO i = nxl, nxr 7667 7722 DO j = nys, nyn … … 7684 7739 ENDDO 7685 7740 ELSE 7741 IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) ) THEN 7742 ALLOCATE( rad_lw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) ) 7743 rad_lw_cs_hr_av = REAL( fill_value, KIND = wp ) 7744 ENDIF 7686 7745 DO i = nxl, nxr 7687 7746 DO j = nys, nyn … … 7704 7763 ENDDO 7705 7764 ELSE 7765 IF ( .NOT. ALLOCATED( rad_lw_hr_av ) ) THEN 7766 ALLOCATE( rad_lw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) ) 7767 rad_lw_hr_av= REAL( fill_value, KIND = wp ) 7768 ENDIF 7706 7769 DO i = nxl, nxr 7707 7770 DO j = nys, nyn … … 7724 7787 ENDDO 7725 7788 ELSE 7789 IF ( .NOT. ALLOCATED( rad_sw_in_av ) ) THEN 7790 ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 7791 rad_sw_in_av = REAL( fill_value, KIND = wp ) 7792 ENDIF 7726 7793 DO i = nxl, nxr 7727 7794 DO j = nys, nyn … … 7744 7811 ENDDO 7745 7812 ELSE 7813 IF ( .NOT. ALLOCATED( rad_sw_out_av ) ) THEN 7814 ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 7815 rad_sw_out_av = REAL( fill_value, KIND = wp ) 7816 ENDIF 7746 7817 DO i = nxl, nxr 7747 7818 DO j = nys, nyn … … 7764 7835 ENDDO 7765 7836 ELSE 7837 IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) ) THEN 7838 ALLOCATE( rad_sw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) ) 7839 rad_sw_cs_hr_av = REAL( fill_value, KIND = wp ) 7840 ENDIF 7766 7841 DO i = nxl, nxr 7767 7842 DO j = nys, nyn … … 7784 7859 ENDDO 7785 7860 ELSE 7861 IF ( .NOT. ALLOCATED( rad_sw_hr_av ) ) THEN 7862 ALLOCATE( rad_sw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) ) 7863 rad_sw_hr_av = REAL( fill_value, KIND = wp ) 7864 ENDIF 7786 7865 DO i = nxl, nxr 7787 7866 DO j = nys, nyn … … 7827 7906 7828 7907 LOGICAL :: found !< 7908 7909 REAL(wp) :: fill_value = 999.0_wp !< value for the _FillValue attribute 7829 7910 7830 7911 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !< … … 7846 7927 ENDDO 7847 7928 ELSE 7929 IF ( .NOT. ALLOCATED( rad_sw_in_av ) ) THEN 7930 ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 7931 rad_sw_in_av = REAL( fill_value, KIND = wp ) 7932 ENDIF 7848 7933 DO i = nxl, nxr 7849 7934 DO j = nys, nyn … … 7865 7950 ENDDO 7866 7951 ELSE 7952 IF ( .NOT. ALLOCATED( rad_sw_out_av ) ) THEN 7953 ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 7954 rad_sw_out_av = REAL( fill_value, KIND = wp ) 7955 ENDIF 7867 7956 DO i = nxl, nxr 7868 7957 DO j = nys, nyn … … 7884 7973 ENDDO 7885 7974 ELSE 7975 IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) ) THEN 7976 ALLOCATE( rad_sw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) ) 7977 rad_sw_cs_hr_av = REAL( fill_value, KIND = wp ) 7978 ENDIF 7886 7979 DO i = nxl, nxr 7887 7980 DO j = nys, nyn … … 7903 7996 ENDDO 7904 7997 ELSE 7998 IF ( .NOT. ALLOCATED( rad_sw_hr_av ) ) THEN 7999 ALLOCATE( rad_sw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) ) 8000 rad_sw_hr_av = REAL( fill_value, KIND = wp ) 8001 ENDIF 7905 8002 DO i = nxl, nxr 7906 8003 DO j = nys, nyn … … 7922 8019 ENDDO 7923 8020 ELSE 8021 IF ( .NOT. ALLOCATED( rad_lw_in_av ) ) THEN 8022 ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 8023 rad_lw_in_av = REAL( fill_value, KIND = wp ) 8024 ENDIF 7924 8025 DO i = nxl, nxr 7925 8026 DO j = nys, nyn … … 7941 8042 ENDDO 7942 8043 ELSE 8044 IF ( .NOT. ALLOCATED( rad_lw_out_av ) ) THEN 8045 ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 8046 rad_lw_out_av = REAL( fill_value, KIND = wp ) 8047 ENDIF 7943 8048 DO i = nxl, nxr 7944 8049 DO j = nys, nyn … … 7960 8065 ENDDO 7961 8066 ELSE 8067 IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) ) THEN 8068 ALLOCATE( rad_lw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) ) 8069 rad_lw_cs_hr_av = REAL( fill_value, KIND = wp ) 8070 ENDIF 7962 8071 DO i = nxl, nxr 7963 8072 DO j = nys, nyn … … 7979 8088 ENDDO 7980 8089 ELSE 8090 IF ( .NOT. ALLOCATED( rad_lw_hr_av ) ) THEN 8091 ALLOCATE( rad_lw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) ) 8092 rad_lw_hr_av = REAL( fill_value, KIND = wp ) 8093 ENDIF 7981 8094 DO i = nxl, nxr 7982 8095 DO j = nys, nyn
Note: See TracChangeset
for help on using the changeset viewer.