Changeset 13384 for branches/UKMO/dev_r5518_obs_oper_update_vel_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
- Timestamp:
- 2020-08-06T10:50:07+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_vel_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r12610 r13384 544 544 545 545 SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj, & 546 & kit000, kdaystp, psurf, pclim, psurfmask, & 546 & kit000, kdaystp, kvar, & 547 & psurf, pclim, psurfmask, & 548 & plam, pphi, & 547 549 & k2dint, ldnightav, plamscl, pphiscl, & 548 550 & lindegrees, kmeanstp ) … … 579 581 !! ! 15-02 (M. Martin) Combined routine for surface types 580 582 !! ! 17-03 (M. Martin) Added horizontal averaging options 583 !! ! 20-08 (M. Martin) Added surface velocity options 581 584 !!----------------------------------------------------------------------- 582 585 … … 595 598 ! (kit000-1 = restart time) 596 599 INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day 600 INTEGER, INTENT(IN) :: kvar ! Number of variables in surfdataqc 597 601 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 598 602 INTEGER, INTENT(IN), OPTIONAL :: & … … 603 607 & pclim, & ! Climatological surface field 604 608 & psurfmask ! Land-sea mask 609 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 610 & plam, & ! Model longitudes for variable 611 & pphi ! Model latitudes for variable 605 612 LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data 606 613 REAL(KIND=wp), INTENT(IN) :: & … … 670 677 CALL obs_max_fpsize( k2dint, plamscl, pphiscl, lindegrees, psurfmask, imaxifp, imaxjfp ) 671 678 672 673 679 IF ( l_timemean ) THEN 674 680 ! Initialize time mean for first timestep … … 681 687 DO jj = 1, jpj 682 688 DO ji = 1, jpi 683 surfdataqc%vdmean(ji,jj ) = 0.0689 surfdataqc%vdmean(ji,jj,kvar) = 0.0 684 690 END DO 685 691 END DO … … 690 696 DO jj = 1, jpj 691 697 DO ji = 1, jpi 692 surfdataqc%vdmean(ji,jj ) = surfdataqc%vdmean(ji,jj) &693 & + psurf(ji,jj)698 surfdataqc%vdmean(ji,jj,kvar) = surfdataqc%vdmean(ji,jj,kvar) & 699 & + psurf(ji,jj) 694 700 END DO 695 701 END DO … … 701 707 DO jj = 1, jpj 702 708 DO ji = 1, jpi 703 surfdataqc%vdmean(ji,jj ) = surfdataqc%vdmean(ji,jj) &704 & * zmeanstp709 surfdataqc%vdmean(ji,jj,kvar) = surfdataqc%vdmean(ji,jj,kvar) & 710 & * zmeanstp 705 711 END DO 706 712 END DO … … 729 735 DO jj = 1, jpj 730 736 DO ji = 1, jpi 731 surfdataqc%vdmean(ji,jj ) = 0.0737 surfdataqc%vdmean(ji,jj,kvar) = 0.0 732 738 zmeanday(ji,jj) = 0.0 733 739 icount_night(ji,jj) = 0 … … 743 749 DO ji = 1, jpi 744 750 ! Increment the temperature field for computing night mean and counter 745 surfdataqc%vdmean(ji,jj ) = surfdataqc%vdmean(ji,jj) &746 & + psurf(ji,jj) * REAL( imask_night(ji,jj) )751 surfdataqc%vdmean(ji,jj,kvar) = surfdataqc%vdmean(ji,jj,kvar) & 752 & + psurf(ji,jj) * REAL( imask_night(ji,jj) ) 747 753 zmeanday(ji,jj) = zmeanday(ji,jj) + psurf(ji,jj) 748 754 icount_night(ji,jj) = icount_night(ji,jj) + imask_night(ji,jj) … … 758 764 ! Test if "no night" point 759 765 IF ( icount_night(ji,jj) > 0 ) THEN 760 surfdataqc%vdmean(ji,jj ) = surfdataqc%vdmean(ji,jj) &761 & / REAL( icount_night(ji,jj) )766 surfdataqc%vdmean(ji,jj,kvar) = surfdataqc%vdmean(ji,jj,kvar) & 767 & / REAL( icount_night(ji,jj) ) 762 768 ELSE 763 769 !At locations where there is no night (e.g. poles), 764 770 ! calculate daily mean instead of night-time mean. 765 surfdataqc%vdmean(ji,jj ) = zmeanday(ji,jj) * zdaystp771 surfdataqc%vdmean(ji,jj,kvar) = zmeanday(ji,jj) * zdaystp 766 772 ENDIF 767 773 END DO … … 772 778 773 779 ! Get the data for interpolation 774 775 780 ALLOCATE( & 776 & zweig(imaxifp,imaxjfp,1), & 777 & igrdi(imaxifp,imaxjfp,isurf), & 778 & igrdj(imaxifp,imaxjfp,isurf), & 779 & zglam(imaxifp,imaxjfp,isurf), & 780 & zgphi(imaxifp,imaxjfp,isurf), & 781 & zmask(imaxifp,imaxjfp,isurf), & 782 & zsurf(imaxifp,imaxjfp,isurf), & 783 & zsurftmp(imaxifp,imaxjfp,isurf), & 784 & zglamf(imaxifp+1,imaxjfp+1,isurf), & 785 & zgphif(imaxifp+1,imaxjfp+1,isurf), & 786 & igrdip1(imaxifp+1,imaxjfp+1,isurf), & 787 & igrdjp1(imaxifp+1,imaxjfp+1,isurf) & 781 & zweig(imaxifp,imaxjfp,1), & 782 & igrdi(imaxifp,imaxjfp,isurf), & 783 & igrdj(imaxifp,imaxjfp,isurf), & 784 & zglam(imaxifp,imaxjfp,isurf), & 785 & zgphi(imaxifp,imaxjfp,isurf), & 786 & zmask(imaxifp,imaxjfp,isurf), & 787 & zsurf(imaxifp,imaxjfp,isurf), & 788 & zsurftmp(imaxifp,imaxjfp,isurf) & 788 789 & ) 790 791 IF ( k2dint > 4 ) THEN 792 ALLOCATE( & 793 & zglamf(imaxifp+1,imaxjfp+1,isurf), & 794 & zgphif(imaxifp+1,imaxjfp+1,isurf), & 795 & igrdip1(imaxifp+1,imaxjfp+1,isurf), & 796 & igrdjp1(imaxifp+1,imaxjfp+1,isurf) & 797 & ) 798 ENDIF 789 799 790 800 IF ( surfdataqc%lclim ) ALLOCATE( zclim(imaxifp,imaxjfp,isurf) ) … … 793 803 iobs = jobs - surfdataqc%nsurfup 794 804 DO ji = 0, imaxifp 795 imodi = surfdataqc%mi(jobs ) - int(imaxifp/2) + ji - 1805 imodi = surfdataqc%mi(jobs,kvar) - int(imaxifp/2) + ji - 1 796 806 797 807 !Deal with wrap around in longitude … … 800 810 801 811 DO jj = 0, imaxjfp 802 imodj = surfdataqc%mj(jobs ) - int(imaxjfp/2) + jj - 1812 imodj = surfdataqc%mj(jobs,kvar) - int(imaxjfp/2) + jj - 1 803 813 !If model values are out of the domain to the north/south then 804 814 !set them to be the edge of the domain … … 806 816 IF ( imodj > jpjglo ) imodj = jpjglo 807 817 808 igrdip1(ji+1,jj+1,iobs) = imodi 809 igrdjp1(ji+1,jj+1,iobs) = imodj 818 IF ( k2dint > 4 ) THEN 819 igrdip1(ji+1,jj+1,iobs) = imodi 820 igrdjp1(ji+1,jj+1,iobs) = imodj 821 ENDIF 810 822 811 823 IF ( ji >= 1 .AND. jj >= 1 ) THEN … … 819 831 820 832 CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 821 & igrdi, igrdj, glamt, zglam )833 & igrdi, igrdj, plam, zglam ) 822 834 CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 823 & igrdi, igrdj, gphit, zgphi )835 & igrdi, igrdj, pphi, zgphi ) 824 836 CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 825 837 & igrdi, igrdj, psurfmask, zmask ) … … 831 843 IF (lwp) WRITE(numout,*)' Interpolating the time mean values on time step: ',kt 832 844 CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 833 & igrdi, igrdj, surfdataqc%vdmean(:,: ), zsurfm )845 & igrdi, igrdj, surfdataqc%vdmean(:,:,kvar), zsurfm ) 834 846 ENDIF 835 847 ELSE … … 858 870 859 871 CALL obs_int_comm_2d( imaxifp,imaxjfp, isurf, kpi, kpj, igrdi, igrdj, & 860 & surfdataqc%vdmean(:,:), zsurfm )872 & surfdataqc%vdmean(:,:,kvar), zsurfm ) 861 873 862 874 ENDIF … … 937 949 surfdataqc%rmod(jobs,1) = surfdataqc%rext(jobs,1) - surfdataqc%rext(jobs,2) 938 950 ELSE 939 surfdataqc%rmod(jobs, 1) = zext(1)951 surfdataqc%rmod(jobs,kvar) = zext(1) 940 952 ENDIF 941 953 … … 985 997 & zmask, & 986 998 & zsurf, & 987 & zsurftmp, & 988 & zglamf, & 989 & zgphif, & 990 & igrdip1,& 991 & igrdjp1 & 999 & zsurftmp & 992 1000 & ) 993 1001 1002 IF ( k2dint > 4 ) THEN 1003 DEALLOCATE( & 1004 & zglamf, & 1005 & zgphif, & 1006 & igrdip1,& 1007 & igrdjp1 & 1008 & ) 1009 ENDIF 1010 994 1011 IF ( surfdataqc%lclim ) DEALLOCATE( zclim ) 995 1012 … … 1001 1018 ENDIF 1002 1019 1003 surfdataqc%nsurfup = surfdataqc%nsurfup + isurf 1020 IF ( kvar == surfdataqc%nvar ) THEN 1021 surfdataqc%nsurfup = surfdataqc%nsurfup + isurf 1022 ENDIF 1004 1023 1005 1024 END SUBROUTINE obs_surf_opt
Note: See TracChangeset
for help on using the changeset viewer.
